{-|
  Copyright   :  (C) 2015-2016, University of Twente,
                     2017-2018, Google Inc.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>

  Generate 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.Bits                            (Bits, testBit)
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)
#if !MIN_VERSION_base(4,11,0)
import           Data.Monoid                          hiding (Sum, Product)
#endif
import           Data.Semigroup.Monad
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.Core.Var                       (Attr'(..))
import           Clash.Debug                          (traceIf)
import           Clash.Backend
import           Clash.Backend.Verilog
  (bits, bit_char, encodingNote, exprLit, include, noEmptyInit, uselibs)
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, intWidth)
import           Clash.Netlist.Util
import           Clash.Signal.Internal                (ActiveEdge (..))
import           Clash.Util
  (SrcSpan, noSrcSpan, curLoc, makeCached, first, on, 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 -> ModName
_modNm     :: ModName
    , SystemVerilogState -> IdentifierSet
_idSeen    :: IdentifierSet
    , SystemVerilogState -> [Identifier]
_oports    :: [Identifier]
    , SystemVerilogState -> SrcSpan
_srcSpan   :: SrcSpan
    , SystemVerilogState -> [(String, Doc)]
_includes  :: [(String,Doc)]
    , SystemVerilogState -> [Text]
_imports   :: [Text.Text]
    , SystemVerilogState -> [Text]
_libraries :: [Text.Text]
    , SystemVerilogState -> [(String, String)]
_dataFiles      :: [(String,FilePath)]
    -- ^ Files to be copied: (filename, old path)
    , SystemVerilogState -> [(String, String)]
_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
    }

makeLenses ''SystemVerilogState

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

instance Backend SystemVerilogState where
  initBackend :: Int
-> HdlSyn
-> Bool
-> PreserveCase
-> Maybe (Maybe Int)
-> AggressiveXOptBB
-> SystemVerilogState
initBackend Int
w HdlSyn
hdlsyn_ Bool
esc PreserveCase
lw Maybe (Maybe Int)
undefVal AggressiveXOptBB
xOpt = SystemVerilogState :: HashSet HWType
-> HashMap HWType Identifier
-> Int
-> ModName
-> IdentifierSet
-> [Identifier]
-> SrcSpan
-> [(String, Doc)]
-> [Text]
-> [Text]
-> [(String, String)]
-> [(String, String)]
-> Bool
-> Int
-> HdlSyn
-> Maybe (Maybe Int)
-> AggressiveXOptBB
-> SystemVerilogState
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 :: ModName
_modNm=ModName
""
    , _idSeen :: IdentifierSet
_idSeen=Bool -> PreserveCase -> HDL -> IdentifierSet
Id.emptyIdentifierSet Bool
esc PreserveCase
lw HDL
SystemVerilog
    , _oports :: [Identifier]
_oports=[]
    , _srcSpan :: SrcSpan
_srcSpan=SrcSpan
noSrcSpan
    , _includes :: [(String, Doc)]
_includes=[]
    , _imports :: [Text]
_imports=[]
    , _libraries :: [Text]
_libraries=[]
    , _dataFiles :: [(String, String)]
_dataFiles=[]
    , _memoryDataFiles :: [(String, String)]
_memoryDataFiles=[]
    , _tyPkgCtx :: Bool
_tyPkgCtx=Bool
False
    , _intWidth :: Int
_intWidth=Int
w
    , _hdlsyn :: HdlSyn
_hdlsyn=HdlSyn
hdlsyn_
    , _undefValue :: Maybe (Maybe Int)
_undefValue=Maybe (Maybe Int)
undefVal
    , _aggressiveXOptBB_ :: AggressiveXOptBB
_aggressiveXOptBB_=AggressiveXOptBB
xOpt
    }
  hdlKind :: SystemVerilogState -> HDL
hdlKind         = HDL -> SystemVerilogState -> HDL
forall a b. a -> b -> a
const HDL
SystemVerilog
  primDirs :: SystemVerilogState -> IO [String]
primDirs        = IO [String] -> SystemVerilogState -> IO [String]
forall a b. a -> b -> a
const (IO [String] -> SystemVerilogState -> IO [String])
-> IO [String] -> SystemVerilogState -> IO [String]
forall a b. (a -> b) -> a -> b
$ do String
root <- IO String
primsRoot
                               [String] -> IO [String]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [ String
root String -> String -> String
System.FilePath.</> String
"common"
                                      , String
root String -> String -> String
System.FilePath.</> String
"commonverilog"
                                      , String
root String -> String -> String
System.FilePath.</> String
"systemverilog"
                                      ]
  extractTypes :: SystemVerilogState -> HashSet HWType
extractTypes    = SystemVerilogState -> HashSet HWType
_tyCache
  name :: SystemVerilogState -> String
name            = String -> SystemVerilogState -> String
forall a b. a -> b -> a
const String
"systemverilog"
  extension :: SystemVerilogState -> String
extension       = String -> SystemVerilogState -> String
forall a b. a -> b -> a
const String
".sv"

  genHDL :: ModName
-> SrcSpan
-> IdentifierSet
-> Component
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
genHDL          = ModName
-> SrcSpan
-> IdentifierSet
-> Component
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
genSystemVerilog
  mkTyPackage :: ModName
-> [HWType] -> Mon (State SystemVerilogState) [(String, Doc)]
mkTyPackage     = ModName
-> [HWType] -> Mon (State SystemVerilogState) [(String, Doc)]
mkTyPackage_
  hdlHWTypeKind :: HWType -> State SystemVerilogState HWKind
hdlHWTypeKind = \case
    Vector {} -> HWKind -> State SystemVerilogState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    RTree {} -> HWKind -> State SystemVerilogState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    Product {} -> HWKind -> State SystemVerilogState HWKind
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']
_ HWType
ty -> HWType -> State SystemVerilogState HWKind
forall state. Backend state => HWType -> State state HWKind
hdlHWTypeKind HWType
ty
    HWType
_ -> HWKind -> State SystemVerilogState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
  hdlType :: Usage -> HWType -> Mon (State SystemVerilogState) Doc
hdlType Usage
_       = HWType -> Mon (State SystemVerilogState) Doc
verilogType
  hdlTypeErrValue :: HWType -> Mon (State SystemVerilogState) Doc
hdlTypeErrValue = HWType -> Mon (State SystemVerilogState) Doc
verilogTypeErrValue
  hdlTypeMark :: HWType -> Mon (State SystemVerilogState) Doc
hdlTypeMark     = HWType -> Mon (State SystemVerilogState) Doc
verilogTypeMark
  hdlRecSel :: HWType -> Int -> Mon (State SystemVerilogState) Doc
hdlRecSel       = HWType -> Int -> Mon (State SystemVerilogState) Doc
verilogRecSel
  hdlSig :: Text -> HWType -> Mon (State SystemVerilogState) Doc
hdlSig Text
t HWType
ty     = Mon (State SystemVerilogState) Doc
-> HWType -> Mon (State SystemVerilogState) Doc
sigDecl (Text -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) (Maybe Doc)
inst            = Declaration -> Mon (State SystemVerilogState) (Maybe Doc)
inst_
  expr :: Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr            = Bool -> Expr -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
toBV HWType
hty Text
id_    = HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV HWType
hty (Identifier -> Maybe Modifier -> Expr
Identifier (HasCallStack => ModName -> Identifier
ModName -> Identifier
Id.unsafeMake (Text -> ModName
Text.toStrict Text
id_)) Maybe Modifier
forall a. Maybe a
Nothing)
  fromBV :: HWType -> Text -> Mon (State SystemVerilogState) Doc
fromBV HWType
hty Text
id_  = HWType -> ModName -> Mon (State SystemVerilogState) Doc
simpleFromSLV HWType
hty (Text -> ModName
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 :: ModName -> SystemVerilogState -> SystemVerilogState
setModName ModName
nm SystemVerilogState
s = SystemVerilogState
s {_modNm :: ModName
_modNm = ModName
nm}
  setSrcSpan :: SrcSpan -> State SystemVerilogState ()
setSrcSpan      = ((SrcSpan -> Identity SrcSpan)
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState SrcSpan
srcSpan ((SrcSpan -> Identity SrcSpan)
 -> SystemVerilogState -> Identity SystemVerilogState)
-> SrcSpan -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)
  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] -> Mon (State SystemVerilogState) Doc
blockDecl Identifier
_ [Declaration]
ds  = do
    Doc
decs <- [Declaration] -> Mon (State SystemVerilogState) Doc
decls [Declaration]
ds
    if Doc -> Bool
isEmpty Doc
decs
      then [Declaration] -> Mon (State SystemVerilogState) Doc
insts [Declaration]
ds
      else
        Doc -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
decs Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
        [Declaration] -> Mon (State SystemVerilogState) Doc
insts [Declaration]
ds
  addIncludes :: [(String, Doc)] -> State SystemVerilogState ()
addIncludes [(String, Doc)]
inc = ([(String, Doc)] -> Identity [(String, Doc)])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [(String, Doc)]
includes (([(String, Doc)] -> Identity [(String, Doc)])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> ([(String, Doc)] -> [(String, Doc)])
-> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([(String, Doc)]
inc[(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
forall a. [a] -> [a] -> [a]
++)
  addLibraries :: [Text] -> State 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 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++)
  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 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++)
  addAndSetData :: String -> State SystemVerilogState String
addAndSetData String
f = do
    [(String, String)]
fs <- Getting [(String, String)] SystemVerilogState [(String, String)]
-> State SystemVerilogState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] SystemVerilogState [(String, String)]
Lens' SystemVerilogState [(String, String)]
dataFiles
    let ([(String, String)]
fs',String
f') = [(String, String)] -> String -> ([(String, String)], String)
renderFilePath [(String, String)]
fs String
f
    ([(String, String)] -> Identity [(String, String)])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [(String, String)]
dataFiles (([(String, String)] -> Identity [(String, String)])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> [(String, String)] -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(String, String)]
fs'
    String -> State SystemVerilogState String
forall (m :: Type -> Type) a. Monad m => a -> m a
return String
f'
  getDataFiles :: State SystemVerilogState [(String, String)]
getDataFiles = Getting [(String, String)] SystemVerilogState [(String, String)]
-> State SystemVerilogState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] SystemVerilogState [(String, String)]
Lens' SystemVerilogState [(String, String)]
dataFiles
  addMemoryDataFile :: (String, String) -> State SystemVerilogState ()
addMemoryDataFile (String, String)
f = ([(String, String)] -> Identity [(String, String)])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [(String, String)]
memoryDataFiles (([(String, String)] -> Identity [(String, String)])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> ([(String, String)] -> [(String, String)])
-> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String, String)
f(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:)
  getMemoryDataFiles :: State SystemVerilogState [(String, String)]
getMemoryDataFiles = Getting [(String, String)] SystemVerilogState [(String, String)]
-> State SystemVerilogState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] SystemVerilogState [(String, String)]
Lens' SystemVerilogState [(String, String)]
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_

type SystemVerilogM a = Mon (State SystemVerilogState) a

-- | Generate SystemVerilog for a Netlist component
genSystemVerilog
  :: ModName
  -> SrcSpan
  -> IdentifierSet
  -> Component
  -> SystemVerilogM ((String, Doc), [(String, Doc)])
genSystemVerilog :: ModName
-> SrcSpan
-> IdentifierSet
-> Component
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
genSystemVerilog ModName
_ SrcSpan
sp IdentifierSet
seen 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 () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState () -> Mon (State SystemVerilogState) ())
-> State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall a b. (a -> b) -> a -> b
$ (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

    State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState () -> Mon (State SystemVerilogState) ())
-> State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> State SystemVerilogState ()
forall state. Backend state => SrcSpan -> State state ()
setSrcSpan SrcSpan
sp
    Doc
v    <- Mon (State SystemVerilogState) Doc
verilog
    [(String, Doc)]
incs <- State SystemVerilogState [(String, Doc)]
-> Mon (State SystemVerilogState) [(String, Doc)]
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState [(String, Doc)]
 -> Mon (State SystemVerilogState) [(String, Doc)])
-> State SystemVerilogState [(String, Doc)]
-> Mon (State SystemVerilogState) [(String, Doc)]
forall a b. (a -> b) -> a -> b
$ Getting [(String, Doc)] SystemVerilogState [(String, Doc)]
-> State SystemVerilogState [(String, Doc)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, Doc)] SystemVerilogState [(String, Doc)]
Lens' SystemVerilogState [(String, Doc)]
includes
    ((String, Doc), [(String, Doc)])
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((ModName -> String
TextS.unpack (Identifier -> ModName
Id.toText Identifier
cName), Doc
v), [(String, Doc)]
incs)
  where
    cName :: Identifier
cName   = Component -> Identifier
componentName Component
c
    verilog :: Mon (State SystemVerilogState) Doc
verilog = Mon (State SystemVerilogState) Doc
commentHeader Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
              Mon (State SystemVerilogState) Doc
timescale Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
              Component -> Mon (State SystemVerilogState) Doc
module_ Component
c
    commentHeader :: Mon (State SystemVerilogState) Doc
commentHeader
         = Mon (State SystemVerilogState) Doc
"/* AUTOMATICALLY GENERATED SYSTEMVERILOG-2005 SOURCE CODE."
      Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"** GENERATED BY CLASH " Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (String -> Text
Text.pack String
clashVer) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
". DO NOT MODIFY."
      Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"*/"
    timescale :: Mon (State SystemVerilogState) Doc
timescale = Mon (State SystemVerilogState) Doc
"`timescale 100fs/100fs"

-- | Generate a SystemVerilog package containing type definitions for the given HWTypes
mkTyPackage_ :: TextS.Text -> [HWType] -> SystemVerilogM [(String,Doc)]
mkTyPackage_ :: ModName
-> [HWType] -> Mon (State SystemVerilogState) [(String, Doc)]
mkTyPackage_ ModName
modName [HWType]
hwtys = do
    State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((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])
-> Mon (State SystemVerilogState) [HWType]
-> Mon (State SystemVerilogState) [HWType]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (HWType -> Mon (State SystemVerilogState) HWType)
-> [HWType] -> Mon (State SystemVerilogState) [HWType]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HWType -> Mon (State 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 :: Mon (State SystemVerilogState) Doc
packageDec  = Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State SystemVerilogState) [Doc]
 -> Mon (State SystemVerilogState) Doc)
-> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$ ([Maybe Doc] -> [Doc])
-> Mon (State SystemVerilogState) [Maybe Doc]
-> Mon (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes (Mon (State SystemVerilogState) [Maybe Doc]
 -> Mon (State SystemVerilogState) [Doc])
-> Mon (State SystemVerilogState) [Maybe Doc]
-> Mon (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ (HWType -> Mon (State SystemVerilogState) (Maybe Doc))
-> [HWType] -> Mon (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)
mapM HWType -> Mon (State SystemVerilogState) (Maybe Doc)
tyDec [HWType]
hwTysSorted
      funDecs :: Mon (State SystemVerilogState) Doc
funDecs     = Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State SystemVerilogState) [Doc]
 -> Mon (State SystemVerilogState) Doc)
-> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$ ([Maybe Doc] -> [Doc])
-> Mon (State SystemVerilogState) [Maybe Doc]
-> Mon (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes (Mon (State SystemVerilogState) [Maybe Doc]
 -> Mon (State SystemVerilogState) [Doc])
-> Mon (State SystemVerilogState) [Maybe Doc]
-> Mon (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ (HWType -> Mon (State SystemVerilogState) (Maybe Doc))
-> [HWType] -> Mon (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)
mapM HWType -> Mon (State SystemVerilogState) (Maybe Doc)
funDec [HWType]
hwTysSorted

    [(String, Doc)]
pkg <- ((String, Doc) -> [(String, Doc)] -> [(String, Doc)]
forall a. a -> [a] -> [a]
:[]) ((String, Doc) -> [(String, Doc)])
-> (Doc -> (String, Doc)) -> Doc -> [(String, Doc)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (ModName -> String
TextS.unpack ModName
modName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_types",) (Doc -> [(String, Doc)])
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) [(String, Doc)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$>
       Mon (State SystemVerilogState) Doc
"package" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
modNameD Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_types" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
         Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 Mon (State SystemVerilogState) Doc
packageDec Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
         Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 Mon (State SystemVerilogState) Doc
funDecs Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
       Mon (State SystemVerilogState) Doc
"endpackage" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
modNameD Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_types"
    State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((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)
    [(String, Doc)] -> Mon (State SystemVerilogState) [(String, Doc)]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [(String, Doc)]
pkg
  where
    modNameD :: Mon (State SystemVerilogState) Doc
modNameD    = ModName -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => ModName -> f Doc
stringS ModName
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 (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 (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 ModName
_ [ModName]
_)           = Bool
True
    isUnsigned (CustomSum ModName
_ DataRepr'
_ Int
_ [(ConstrRepr', ModName)]
_) = Bool
True
    isUnsigned (SP ModName
_ [(ModName, [HWType])]
_)            = Bool
True
    isUnsigned (CustomSP ModName
_ DataRepr'
_ Int
_ [(ConstrRepr', ModName, [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 ModName
_ Maybe [ModName]
_ [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 ModName
_ [(ModName, [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 (((ModName, [HWType]) -> [HWType])
-> [(ModName, [HWType])] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (ModName, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(ModName, [HWType])]
elTys)
mkUsedTys HWType
t                     = [HWType
t]

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

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

normaliseType :: HWType -> SystemVerilogM HWType
normaliseType :: HWType -> Mon (State SystemVerilogState) HWType
normaliseType (Annotated [Attr']
_ HWType
ty) = HWType -> Mon (State SystemVerilogState) HWType
normaliseType HWType
ty
normaliseType (Vector Int
n HWType
ty)    = Int -> HWType -> HWType
Vector Int
n (HWType -> HWType)
-> Mon (State SystemVerilogState) HWType
-> Mon (State SystemVerilogState) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (HWType -> Mon (State SystemVerilogState) HWType
normaliseType HWType
ty)
normaliseType (RTree Int
d HWType
ty)     = Int -> HWType -> HWType
RTree Int
d (HWType -> HWType)
-> Mon (State SystemVerilogState) HWType
-> Mon (State SystemVerilogState) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (HWType -> Mon (State SystemVerilogState) HWType
normaliseType HWType
ty)
normaliseType (Product ModName
nm Maybe [ModName]
lbls [HWType]
tys) = ModName -> Maybe [ModName] -> [HWType] -> HWType
Product ModName
nm Maybe [ModName]
lbls ([HWType] -> HWType)
-> Mon (State SystemVerilogState) [HWType]
-> Mon (State SystemVerilogState) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((HWType -> Mon (State SystemVerilogState) HWType)
-> [HWType] -> Mon (State SystemVerilogState) [HWType]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HWType -> Mon (State SystemVerilogState) HWType
normaliseType [HWType]
tys)
normaliseType ty :: HWType
ty@(SP ModName
_ [(ModName, [HWType])]
elTys)      = do
  State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState () -> Mon (State SystemVerilogState) ())
-> State SystemVerilogState () -> Mon (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 -> 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 ()
%=) ((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) (((ModName, [HWType]) -> [HWType])
-> [(ModName, [HWType])] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (ModName, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(ModName, [HWType])]
elTys)
  HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
BitVector (HWType -> Int
typeSize HWType
ty))
normaliseType (CustomSP ModName
_ DataRepr'
_dataRepr Int
size [(ConstrRepr', ModName, [HWType])]
elTys) = do
  State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState () -> Mon (State SystemVerilogState) ())
-> State SystemVerilogState () -> Mon (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 -> 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 ()
%=) ((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'
_, ModName
_, [HWType]
subTys) <- [(ConstrRepr', ModName, [HWType])]
elTys, HWType
ty <- [HWType]
subTys]
  HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
BitVector Int
size)
normaliseType ty :: HWType
ty@(Index Integer
_) = HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
Unsigned (HWType -> Int
typeSize HWType
ty))
normaliseType ty :: HWType
ty@(Sum ModName
_ [ModName]
_) = HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
BitVector (HWType -> Int
typeSize HWType
ty))
normaliseType ty :: HWType
ty@(CustomSum ModName
_ DataRepr'
_ Int
_ [(ConstrRepr', ModName)]
_) = HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
BitVector (HWType -> Int
typeSize HWType
ty))
normaliseType (Clock ModName
_) = HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
Bit
normaliseType (Reset ModName
_) = HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
Bit
normaliseType (Enable ModName
_) = HWType -> Mon (State SystemVerilogState) HWType
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)
-> Mon (State SystemVerilogState) HWType
-> Mon (State SystemVerilogState) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> HWType -> Mon (State SystemVerilogState) HWType
normaliseType HWType
ty
normaliseType HWType
ty = HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
ty


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

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

tyDec HWType
_ = Maybe Doc -> Mon (State SystemVerilogState) (Maybe Doc)
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], Mon (State SystemVerilogState) Doc)
splitVecTy = (([Either Int Int], HWType)
 -> ([Either Int Int], Mon (State SystemVerilogState) Doc))
-> Maybe ([Either Int Int], HWType)
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Either Int Int], HWType)
-> ([Either Int Int], Mon (State SystemVerilogState) Doc)
forall b.
([Either Int b], HWType)
-> ([Either Int b], Mon (State SystemVerilogState) Doc)
splitElemTy (Maybe ([Either Int Int], HWType)
 -> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc))
-> (HWType -> Maybe ([Either Int Int], HWType))
-> HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) 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], Mon (State SystemVerilogState) Doc)
splitElemTy ([Either Int b]
ns,HWType
t) = case HWType
t of
      Product {} -> ([Either Int b]
ns, HWType -> Mon (State SystemVerilogState) Doc
verilogType HWType
t)
      Vector {}  -> String -> ([Either Int b], Mon (State SystemVerilogState) Doc)
forall a. HasCallStack => String -> a
error (String -> ([Either Int b], Mon (State SystemVerilogState) Doc))
-> String -> ([Either Int b], Mon (State SystemVerilogState) Doc)
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"impossible"
      Clock {}   -> ([Either Int b]
ns, HWType -> Mon (State SystemVerilogState) Doc
verilogType HWType
t)
      Reset {}   -> ([Either Int b]
ns, Mon (State SystemVerilogState) Doc
"logic")
      Enable {}  -> ([Either Int b]
ns, Mon (State SystemVerilogState) Doc
"logic")
      HWType
Bool       -> ([Either Int b]
ns, Mon (State SystemVerilogState) Doc
"logic")
      HWType
Bit        -> ([Either Int b]
ns, Mon (State SystemVerilogState) Doc
"logic")
      HWType
String     -> ([Either Int b]
ns, Mon (State SystemVerilogState) 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],Mon (State SystemVerilogState) 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)], Mon (State SystemVerilogState) 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 -> Mon (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)
-> Mon (State SystemVerilogState) Doc
-> Mon (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
-> Mon (State SystemVerilogState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> Mon (State SystemVerilogState) Doc
"logic" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
    HdlSyn
_ -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
      Just ([Either Int Int]
ns,Mon (State SystemVerilogState) Doc
elTy') -> Mon (State SystemVerilogState) Doc
elTy' Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either Int Int -> Mon (State SystemVerilogState) Doc)
-> [Either Int Int] -> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Either Int Int -> Mon (State SystemVerilogState) Doc
range [Either Int Int]
ns)
      Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
_ -> String -> Mon (State SystemVerilogState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State SystemVerilogState) Doc)
-> String -> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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)
-> Mon (State SystemVerilogState) Doc
-> Mon (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
-> Mon (State SystemVerilogState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> Mon (State SystemVerilogState) Doc
"logic" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) 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)) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
    HdlSyn
_ -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
      Just ([Either Int Int]
ns,Mon (State SystemVerilogState) Doc
elTy') -> Mon (State SystemVerilogState) Doc
elTy' Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either Int Int -> Mon (State SystemVerilogState) Doc)
-> [Either Int Int] -> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Either Int Int -> Mon (State SystemVerilogState) Doc
range [Either Int Int]
ns)
      Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
_ -> String -> Mon (State SystemVerilogState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State SystemVerilogState) Doc)
-> String -> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> HWType -> Mon (State SystemVerilogState) Doc
verilogType HWType
ty
lvType HWType
_ = Maybe Doc -> Mon (State SystemVerilogState) (Maybe Doc)
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 -> Mon (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)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$>
  Mon (State SystemVerilogState) Doc
"function" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"automatic" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"logic" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
ranges Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_to_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State SystemVerilogState) Doc
-> HWType -> Mon (State SystemVerilogState) Doc
sigDecl Mon (State SystemVerilogState) Doc
"i" HWType
ty) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
  Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
    (Mon (State SystemVerilogState) Doc
"for" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State SystemVerilogState) Doc
"int n = 0" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"n <" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"n=n+1") Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_to_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets Mon (State SystemVerilogState) Doc
"n" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"=" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"i[n]" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
  Mon (State SystemVerilogState) Doc
"endfunction" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
  Mon (State SystemVerilogState) Doc
"function" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"automatic" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_from_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State SystemVerilogState) Doc
"logic" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
ranges Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"i") Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
  Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
    (Mon (State SystemVerilogState) Doc
"for" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State SystemVerilogState) Doc
"int n = 0" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"n <" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"n=n+1") Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_from_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets Mon (State SystemVerilogState) Doc
"n" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"=" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"i[n]" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
  Mon (State SystemVerilogState) Doc
"endfunction" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then
    Mon (State SystemVerilogState) Doc
"function" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"automatic" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_cons" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State SystemVerilogState) Doc
-> HWType -> Mon (State SystemVerilogState) Doc
sigDecl Mon (State SystemVerilogState) Doc
"x" HWType
elTy Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
vecSigDecl Mon (State SystemVerilogState) Doc
"xs") Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
      (Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_cons" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"=" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV HWType
elTy (Identifier -> Maybe Modifier -> Expr
Identifier (HasCallStack => ModName -> Identifier
ModName -> Identifier
Id.unsafeMake ModName
"x") Maybe Modifier
forall a. Maybe a
Nothing)) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
       Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_cons" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"=" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"xs" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Mon (State SystemVerilogState) Doc
"endfunction"
  else
    Mon (State SystemVerilogState) Doc
"function" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"automatic" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_cons" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State SystemVerilogState) Doc
-> HWType -> Mon (State SystemVerilogState) Doc
sigDecl Mon (State SystemVerilogState) Doc
"x" HWType
elTy) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
      (Mon (State SystemVerilogState) Doc
tName Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_cons" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"=" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV HWType
elTy (Identifier -> Maybe Modifier -> Expr
Identifier (HasCallStack => ModName -> Identifier
ModName -> Identifier
Id.unsafeMake ModName
"x") Maybe Modifier
forall a. Maybe a
Nothing)) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Mon (State SystemVerilogState) Doc
"endfunction"
  where
    tName :: Mon (State SystemVerilogState) Doc
tName  = HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
ty
    ranges :: Mon (State SystemVerilogState) Doc
ranges = Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
             Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)

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

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

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

module_ :: Component -> SystemVerilogM Doc
module_ :: Component -> Mon (State SystemVerilogState) Doc
module_ Component
c =
  Mon (State SystemVerilogState) Doc
modVerilog Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) ()
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (([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 (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 :: Mon (State SystemVerilogState) Doc
modVerilog = do
    Doc
body <- Mon (State SystemVerilogState) Doc
modBody
    [Text]
imps <- State SystemVerilogState [Text]
-> Mon (State SystemVerilogState) [Text]
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState [Text]
 -> Mon (State SystemVerilogState) [Text])
-> State SystemVerilogState [Text]
-> Mon (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]
-> Mon (State SystemVerilogState) [Text]
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState [Text]
 -> Mon (State SystemVerilogState) [Text])
-> State SystemVerilogState [Text]
-> Mon (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
    Mon (State SystemVerilogState) Doc
modHeader Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
modPorts Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Text] -> Mon (State SystemVerilogState) Doc
forall (m :: Type -> Type). Monad m => [Text] -> Mon m Doc
include ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
imps) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Text] -> Mon (State SystemVerilogState) Doc
forall (m :: Type -> Type). Monad m => [Text] -> Mon m Doc
uselibs ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
libs) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
body Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
modEnding

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

  inPorts :: Mon (State SystemVerilogState) [Doc]
inPorts  = [Mon (State SystemVerilogState) Doc]
-> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (Maybe Any, Bool)
-> (Identifier, HWType)
-> Maybe Expr
-> Mon (State SystemVerilogState) Doc
forall a a.
Pretty a =>
(Maybe a, Bool)
-> (a, HWType) -> Maybe Expr -> Mon (State SystemVerilogState) 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 :: Mon (State SystemVerilogState) [Doc]
outPorts = [Mon (State SystemVerilogState) Doc]
-> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (Maybe WireOrReg, Bool)
-> (Identifier, HWType)
-> Maybe Expr
-> Mon (State SystemVerilogState) Doc
forall a a.
Pretty a =>
(Maybe a, Bool)
-> (a, HWType) -> Maybe Expr -> Mon (State SystemVerilogState) Doc
sigPort (WireOrReg -> Maybe WireOrReg
forall a. a -> Maybe a
Just WireOrReg
wr,Bool
False) (Identifier, HWType)
p Maybe Expr
iEM | (WireOrReg
wr, (Identifier, HWType)
p, Maybe Expr
iEM) <- Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c ]

  wr2ty :: (Maybe a, Bool) -> p
wr2ty (Maybe a
Nothing,Bool
isBidirectional)
    | Bool
isBidirectional
    = p
"inout"
    | Bool
otherwise
    = p
"input"
  wr2ty (Just a
_,Bool
_)
    = p
"output"

  -- map a port to its verilog type, port name, and any encoding notes
  sigPort :: (Maybe a, Bool)
-> (a, HWType) -> Maybe Expr -> Mon (State SystemVerilogState) Doc
sigPort ((Maybe a, Bool) -> Mon (State SystemVerilogState) Doc
forall p a. IsString p => (Maybe a, Bool) -> p
wr2ty -> Mon (State SystemVerilogState) Doc
portTy) (a
nm, HWType
hwTy) Maybe Expr
iEM
    = [Attr']
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
addAttrs (HWType -> [Attr']
hwTypeAttrs HWType
hwTy)
        (Mon (State SystemVerilogState) Doc
portTy Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> HWType -> Mon (State SystemVerilogState) Doc
sigDecl (a -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty a
nm) HWType
hwTy Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
iE Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State SystemVerilogState) Doc
forall (m :: Type -> Type). Applicative m => HWType -> m Doc
encodingNote HWType
hwTy)
    where
      iE :: Mon (State SystemVerilogState) Doc
iE = Mon (State SystemVerilogState) Doc
-> (Expr -> Mon (State SystemVerilogState) Doc)
-> Maybe Expr
-> Mon (State SystemVerilogState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m Doc -> m Doc
noEmptyInit (Mon (State SystemVerilogState) Doc
 -> Mon (State SystemVerilogState) Doc)
-> (Expr -> Mon (State SystemVerilogState) Doc)
-> Expr
-> Mon (State SystemVerilogState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> Mon (State SystemVerilogState) 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 (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 (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 (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 (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 (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 (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 (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 (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 -> Mon (State SystemVerilogState) Doc
verilogType HWType
t_ = do
  HWType
t <- HWType -> Mon (State SystemVerilogState) HWType
normaliseType HWType
t_
  State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((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 :: Mon (State SystemVerilogState) Doc
logicOrWire | HWType -> Bool
isBiSignalIn HWType
t = Mon (State SystemVerilogState) Doc
"wire"
                  | Bool
otherwise      = Mon (State SystemVerilogState) Doc
"logic"
  Bool
pkgCtx <- State SystemVerilogState Bool
-> Mon (State SystemVerilogState) Bool
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Bool
 -> Mon (State SystemVerilogState) Bool)
-> State SystemVerilogState Bool
-> Mon (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
  ModName
nm <- State SystemVerilogState ModName
-> Mon (State SystemVerilogState) ModName
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState ModName
 -> Mon (State SystemVerilogState) ModName)
-> State SystemVerilogState ModName
-> Mon (State SystemVerilogState) ModName
forall a b. (a -> b) -> a -> b
$ Getting ModName SystemVerilogState ModName
-> State SystemVerilogState ModName
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting ModName SystemVerilogState ModName
Lens' SystemVerilogState ModName
modNm
  let pvrType :: Mon (State SystemVerilogState) Doc
pvrType = if Bool
pkgCtx
                then HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
t
                else ModName -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => ModName -> f Doc
stringS ModName
nm Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_types::" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
t
  case HWType
t of
    Product {}    -> Mon (State SystemVerilogState) Doc
pvrType
    Vector {}     -> Mon (State SystemVerilogState) Doc
pvrType
    RTree {}      -> Mon (State SystemVerilogState) Doc
pvrType
    Signed Int
n      -> Mon (State SystemVerilogState) Doc
logicOrWire Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"signed" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
    Clock ModName
_       -> Mon (State SystemVerilogState) Doc
"logic"
    Reset ModName
_       -> Mon (State SystemVerilogState) Doc
"logic"
    Enable ModName
_      -> Mon (State SystemVerilogState) Doc
"logic"
    HWType
Bit           -> Mon (State SystemVerilogState) Doc
"logic"
    HWType
Bool          -> Mon (State SystemVerilogState) Doc
"logic"
    HWType
String        -> Mon (State SystemVerilogState) Doc
"string"
    HWType
FileType      -> Mon (State SystemVerilogState) Doc
"integer"
    HWType
_ -> Mon (State SystemVerilogState) Doc
logicOrWire Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)

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

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

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

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

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

singularErrValue :: HWType -> SystemVerilogM Doc
singularErrValue :: HWType -> Mon (State SystemVerilogState) Doc
singularErrValue HWType
ty = do
  Maybe (Maybe Int)
udf <- State SystemVerilogState (Maybe (Maybe Int))
-> Mon (State SystemVerilogState) (Maybe (Maybe Int))
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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       -> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces Mon (State SystemVerilogState) Doc
"1'bx")
    Just Maybe Int
Nothing  -> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"'d0 /* undefined */"
    Just (Just Int
x) -> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Mon (State SystemVerilogState) Doc
"1'b" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
x)) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
"/* undefined */"

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

decls :: [Declaration] -> SystemVerilogM Doc
decls :: [Declaration] -> Mon (State SystemVerilogState) Doc
decls [] = Mon (State SystemVerilogState) 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])
-> Mon (State SystemVerilogState) [Maybe Doc]
-> Mon (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (Declaration -> Mon (State SystemVerilogState) (Maybe Doc))
-> [Declaration] -> Mon (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)
mapM Declaration -> Mon (State SystemVerilogState) (Maybe Doc)
decl [Declaration]
ds
    case [Doc]
dsDoc of
      [] -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
      [Doc]
_  -> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (m :: Type -> Type).
Monad m =>
Mon m Doc -> Mon m [Doc] -> Mon m Doc
punctuate' Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi ([Doc] -> Mon (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
A.pure [Doc]
dsDoc)

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

decl Declaration
_ = Maybe Doc -> Mon (State SystemVerilogState) (Maybe Doc)
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' -> Text.Text
renderAttr :: Attr' -> Text
renderAttr (StringAttr'  String
key String
value) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [String
key, String
" = ", String -> String
forall a. Show a => a -> String
show String
value]
renderAttr (IntegerAttr' String
key Integer
value) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [String
key, String
" = ", Integer -> String
forall a. Show a => a -> String
show Integer
value]
renderAttr (BoolAttr'    String
key Bool
True ) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [String
key, String
" = ", String
"1"]
renderAttr (BoolAttr'    String
key Bool
False) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [String
key, String
" = ", String
"0"]
renderAttr (Attr'        String
key      ) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
key

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

insts :: [Declaration] -> SystemVerilogM Doc
insts :: [Declaration] -> Mon (State SystemVerilogState) Doc
insts [] = Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
insts (TickDecl ModName
id_:[Declaration]
ds) = ModName -> ModName -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
ModName -> ModName -> f Doc
comment ModName
"//" ModName
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State SystemVerilogState) Doc
insts [Declaration]
ds
insts (Declaration
d:[Declaration]
ds) = do
  Maybe Doc
docM <- Declaration -> Mon (State SystemVerilogState) (Maybe Doc)
inst_ Declaration
d
  case Maybe Doc
docM of
    Maybe Doc
Nothing -> [Declaration] -> Mon (State SystemVerilogState) Doc
insts [Declaration]
ds
    Just Doc
doc -> Doc -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
doc Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State SystemVerilogState) Doc
insts [Declaration]
ds

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

patLitCustom'
  :: Int
  -> ConstrRepr'
  -> SystemVerilogM Doc
patLitCustom' :: Int -> ConstrRepr' -> Mon (State SystemVerilogState) Doc
patLitCustom' Int
size (ConstrRepr' ModName
_name Int
_n Integer
mask Integer
value [Integer]
_anns) =
  Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
size Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"b" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> (Text -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Mon (State SystemVerilogState) Doc)
-> Text -> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Integer -> String
forall a. Bits a => Int -> a -> a -> String
stdMatch Int
size Integer
mask Integer
value)

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

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

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

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)]
-> Mon (State SystemVerilogState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es = (Doc -> Maybe Doc)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State SystemVerilogState) Doc
 -> Mon (State SystemVerilogState) (Maybe Doc))
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  Mon (State SystemVerilogState) Doc
"always_comb begin" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 Mon (State SystemVerilogState) Doc
casez Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"end"
    where
      casez :: Mon (State SystemVerilogState) Doc
casez =
        Mon (State SystemVerilogState) Doc
"casez" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
var Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
          Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([(Maybe Literal, Expr)] -> Mon (State SystemVerilogState) Doc
conds [(Maybe Literal, Expr)]
esNub) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
        Mon (State SystemVerilogState) 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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Literal -> Literal) -> Maybe Literal -> Maybe Literal
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (HWType -> Literal -> Literal
patMod HWType
scrutTy))) [(Maybe Literal, Expr)]
es
      esNub :: [(Maybe Literal, Expr)]
esNub = ((Maybe Literal, Expr) -> (Maybe Literal, Expr) -> Bool)
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Maybe Literal -> Maybe Literal -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Literal -> Maybe Literal -> Bool)
-> ((Maybe Literal, Expr) -> Maybe Literal)
-> (Maybe Literal, Expr)
-> (Maybe Literal, Expr)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe Literal, Expr) -> Maybe Literal
forall a b. (a, b) -> a
fst) [(Maybe Literal, Expr)]
esMod
      var :: Mon (State SystemVerilogState) Doc
var   = Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
True Expr
scrut

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

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

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

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

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

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

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

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

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

      -- Build bit representations for all constructor arguments
      argExprs :: [Mon (State SystemVerilogState) Doc]
argExprs = ((HWType, Expr) -> Mon (State SystemVerilogState) Doc)
-> [(HWType, Expr)] -> [Mon (State SystemVerilogState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((HWType -> Expr -> Mon (State SystemVerilogState) Doc)
-> (HWType, Expr) -> Mon (State SystemVerilogState) Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HWType -> Expr -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
range' (Lit ([Bit] -> [Bit]
bitsToBits -> [Bit]
ns)) =
        Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int ([Bit] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Bit]
ns) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"b" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Bit -> Mon (State SystemVerilogState) Doc)
-> [Bit] -> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Lens' SystemVerilogState (Maybe (Maybe Int))
-> Bit -> Mon (State SystemVerilogState) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Mon (State s) Doc
bit_char 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' :: Mon (State SystemVerilogState) Doc
expr' = [Mon (State SystemVerilogState) Doc]
argExprs [Mon (State SystemVerilogState) Doc]
-> Int -> Mon (State SystemVerilogState) Doc
forall a. [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
               Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fsize Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
expr'
           | Bool
otherwise ->
               -- Select bits 'start' downto and including 'end'
               let rotated :: Mon (State SystemVerilogState) Doc
rotated  = Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
expr' Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
">>" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end in
               Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fsize Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
rotated

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

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

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

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

seq_ (SeqDecl Declaration
sd) = case Declaration
sd of
  Assignment Identifier
id_ Expr
e ->
    Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) 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)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) (Maybe Doc -> Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc Mon (State SystemVerilogState) (Maybe Doc -> Doc)
-> Mon (State SystemVerilogState) (Maybe Doc)
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Declaration -> Mon (State SystemVerilogState) (Maybe Doc)
inst_ Declaration
sd

  Seq [Seq]
ds ->
    [Seq] -> Mon (State SystemVerilogState) Doc
seqs [Seq]
ds

  Declaration
_ -> String -> Mon (State SystemVerilogState) Doc
forall a. HasCallStack => String -> a
error (Declaration -> String
forall a. Show a => a -> String
show Declaration
sd)

seqs :: [Seq] -> SystemVerilogM Doc
seqs :: [Seq] -> Mon (State SystemVerilogState) Doc
seqs [] = Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
seqs (SeqDecl (TickDecl ModName
id_):[Seq]
ds) = Mon (State SystemVerilogState) Doc
"//" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> ModName -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty ModName
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Seq] -> Mon (State SystemVerilogState) Doc
seqs [Seq]
ds
seqs (Seq
d:[Seq]
ds) = Seq -> Mon (State SystemVerilogState) Doc
seq_ Seq
d Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Seq] -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
expr_ Bool
_ (Literal Maybe (HWType, Int)
sizeM Literal
lit) = Maybe (HWType, Int)
-> Literal -> Mon (State SystemVerilogState) Doc
exprLitSV Maybe (HWType, Int)
sizeM Literal
lit
expr_ Bool
_ (Identifier Identifier
id_ Maybe Modifier
Nothing) = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_
expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed (CustomSP ModName
_id DataRepr'
dataRepr Int
_size [(ConstrRepr', ModName, [HWType])]
args,Int
dcI,Int
fI)))) =
  case HWType
fieldTy of
    Void {} ->
      String -> Mon (State SystemVerilogState) Doc
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
    HWType
_ ->
      HWType
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
expFromSLV HWType
fieldTy (Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Mon (State SystemVerilogState) Doc
 -> Mon (State SystemVerilogState) Doc)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State SystemVerilogState) [Doc]
 -> Mon (State SystemVerilogState) Doc)
-> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State SystemVerilogState) Doc
", " (Mon (State SystemVerilogState) [Doc]
 -> Mon (State SystemVerilogState) [Doc])
-> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Mon (State SystemVerilogState) Doc]
-> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State SystemVerilogState) Doc]
ranges)
 where
  (ConstrRepr' ModName
_name Int
_n Integer
_mask Integer
_value [Integer]
anns, ModName
_, [HWType]
fieldTypes) = [(ConstrRepr', ModName, [HWType])]
args [(ConstrRepr', ModName, [HWType])]
-> Int -> (ConstrRepr', ModName, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI
  ranges :: [Mon (State SystemVerilogState) Doc]
ranges = ((Int, Int) -> Mon (State SystemVerilogState) Doc)
-> [(Int, Int)] -> [Mon (State SystemVerilogState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
(Semigroup (f Doc), Applicative f, IsString (f Doc)) =>
(Int, Int) -> f Doc
range' ([(Int, Int)] -> [Mon (State SystemVerilogState) Doc])
-> [(Int, Int)] -> [Mon (State SystemVerilogState) Doc]
forall a b. (a -> b) -> a -> b
$ Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. [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 = String -> [HWType] -> Int -> HWType
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"panic") [HWType]
fieldTypes Int
fI

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

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed (ty :: HWType
ty@(SP ModName
_ [(ModName, [HWType])]
args),Int
dcI,Int
fI)))) =
    HWType
-> ModName -> Int -> Int -> Mon (State SystemVerilogState) Doc
fromSLV HWType
argTy (Identifier -> ModName
Id.toText Identifier
id_) Int
start Int
end
  where
    argTys :: [HWType]
argTys   = (ModName, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((ModName, [HWType]) -> [HWType])
-> (ModName, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(ModName, [HWType])]
args [(ModName, [HWType])] -> Int -> (ModName, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI
    argTy :: HWType
argTy    = [HWType]
argTys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI
    argSize :: Int
argSize  = HWType -> Int
typeSize HWType
argTy
    other :: Int
other    = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-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 ModName
_ Maybe [ModName]
_ [HWType]
tys),Int
_,Int
fI)))) = do
  ModName
id'<- (Doc -> ModName)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) ModName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ModName
Text.toStrict (Text -> ModName) -> (Doc -> Text) -> Doc -> ModName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
ty Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_sel" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fI)
  HWType -> ModName -> Mon (State SystemVerilogState) Doc
simpleFromSLV ([HWType]
tys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI) ModName
id'

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

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((Vector Int
n HWType
_),Int
1,Int
1)))) = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
l Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) 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
  ModName
id' <- (Doc -> ModName)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) ModName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ModName
Text.toStrict (Text -> ModName) -> (Doc -> Text) -> Doc -> ModName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0))
  HWType -> ModName -> Mon (State SystemVerilogState) Doc
simpleFromSLV HWType
elTy ModName
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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
z Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) 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
  ModName
id' <- (Doc -> ModName)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) ModName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ModName
Text.toStrict (Text -> ModName) -> (Doc -> Text) -> Doc -> ModName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fI))
  HWType -> ModName -> Mon (State SystemVerilogState) Doc
simpleFromSLV HWType
elTy ModName
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
  ModName
id' <- (Doc -> ModName)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) ModName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ModName
Text.toStrict (Text -> ModName) -> (Doc -> Text) -> Doc -> ModName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fI))
  HWType -> ModName -> Mon (State SystemVerilogState) Doc
simpleFromSLV HWType
elTy ModName
id'

expr_ Bool
_ (Identifier Identifier
id_ (Just (DC (ty :: HWType
ty@(SP ModName
_ [(ModName, [HWType])]
_),Int
_)))) = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_
  Just ([Either NMod NMod]
mods,HWType
resTy) -> do
    ModName
nm <- State SystemVerilogState ModName
-> Mon (State SystemVerilogState) ModName
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState ModName
 -> Mon (State SystemVerilogState) ModName)
-> State SystemVerilogState ModName
-> Mon (State SystemVerilogState) ModName
forall a b. (a -> b) -> a -> b
$ Getting ModName SystemVerilogState ModName
-> State SystemVerilogState ModName
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting ModName SystemVerilogState ModName
Lens' SystemVerilogState ModName
modNm
    Bool
pkgCtx <- State SystemVerilogState Bool
-> Mon (State SystemVerilogState) Bool
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Bool
 -> Mon (State SystemVerilogState) Bool)
-> State SystemVerilogState Bool
-> Mon (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 :: Mon (State SystemVerilogState) Doc
prefix = if Bool
pkgCtx then Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else ModName -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => ModName -> f Doc
stringS ModName
nm Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_types::"
    let e :: Mon (State SystemVerilogState) Doc
e = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either NMod NMod -> Mon (State SystemVerilogState) Doc)
-> [Either NMod NMod] -> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((NMod -> Mon (State SystemVerilogState) Doc)
-> (NMod -> Mon (State SystemVerilogState) Doc)
-> Either NMod NMod
-> Mon (State SystemVerilogState) Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either NMod -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
(Applicative f, Semigroup (f Doc)) =>
NMod -> f Doc
bracketNMod NMod -> Mon (State SystemVerilogState) 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
_ -> Mon (State SystemVerilogState) Doc
"$signed" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
e
      Vector {}
        | Left (NRange {}):[Either NMod NMod]
_ <- [Either NMod NMod]
mods
        -> Mon (State SystemVerilogState) Doc
e
        | Bool
otherwise  -> do
        State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((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)
        Mon (State SystemVerilogState) Doc
prefix Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
resTy Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_from_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
e
      RTree {}
        | Left (NRange {}):[Either NMod NMod]
_ <- [Either NMod NMod]
mods
        -> Mon (State SystemVerilogState) Doc
e
        | Bool
otherwise -> do
        State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((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)
        Mon (State SystemVerilogState) Doc
prefix Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
resTy Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_from_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
e
      HWType
_ -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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
-> String
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Mon (State SystemVerilogState) Doc
 -> Mon (State SystemVerilogState) Doc)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$
    Identifier -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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
-> String
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Mon (State SystemVerilogState) Doc
 -> Mon (State SystemVerilogState) Doc)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$
    Identifier -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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
-> String
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Bool -> String -> a -> a
traceIf Bool
True ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: synthesizing bitvector mask to dontcare") (Mon (State SystemVerilogState) Doc
 -> Mon (State SystemVerilogState) Doc)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$
    HWType -> Mon (State SystemVerilogState) Doc
verilogTypeErrValue (Int -> HWType
Signed 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 -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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
-> String
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Mon (State SystemVerilogState) Doc
 -> Mon (State SystemVerilogState) Doc)
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a b. (a -> b) -> a -> b
$
    Identifier -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
":" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)

expr_ Bool
_ (Identifier Identifier
id_ (Just Modifier
_)) = Identifier -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
expr_ Bool
b Expr
e

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

expr_ Bool
_ (DataCon (Vector Int
1 HWType
elTy) Modifier
_ [Expr
e]) = Mon (State SystemVerilogState) Doc
"'" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> Expr -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
"'" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> Mon (State SystemVerilogState) Doc)
-> [Expr] -> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV HWType
elTy) [Expr]
es)
  Maybe [Expr]
Nothing -> HWType -> Mon (State SystemVerilogState) Doc
verilogTypeMark HWType
ty Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_cons" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e1 Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e2)

expr_ Bool
_ (DataCon (RTree Int
0 HWType
elTy) Modifier
_ [Expr
e]) = Mon (State SystemVerilogState) Doc
"'" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> Expr -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Doc
"'" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> Mon (State SystemVerilogState) Doc)
-> [Expr] -> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV HWType
elTy) [Expr]
es)
  Maybe [Expr]
Nothing -> HWType -> Mon (State SystemVerilogState) Doc
verilogTypeMark HWType
ty Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_br" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e1 Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e2)

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

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

expr_ Bool
_ (DataCon ty :: HWType
ty@(Sum ModName
_ [ModName]
_) (DC (HWType
_,Int
i)) []) = Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"'d" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i
expr_ Bool
_ (DataCon ty :: HWType
ty@(CustomSum ModName
_ DataRepr'
_ Int
_ [(ConstrRepr', ModName)]
tys) (DC (HWType
_,Int
i)) []) =
  let (ConstrRepr' ModName
_ Int
_ Integer
_ Integer
value [Integer]
_) = (ConstrRepr', ModName) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', ModName) -> ConstrRepr')
-> (ConstrRepr', ModName) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', ModName)]
tys [(ConstrRepr', ModName)] -> Int -> (ConstrRepr', ModName)
forall a. [a] -> Int -> a
!! Int
i in
  Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"d" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) 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 ModName
_ DataRepr'
dataRepr Int
_size [(ConstrRepr', ModName, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) =
  let (ConstrRepr'
cRepr, ModName
_, [HWType]
argTys) = [(ConstrRepr', ModName, [HWType])]
args [(ConstrRepr', ModName, [HWType])]
-> Int -> (ConstrRepr', ModName, [HWType])
forall a. [a] -> Int -> a
!! Int
i in
  DataRepr'
-> ConstrRepr'
-> [(HWType, Expr)]
-> Mon (State SystemVerilogState) 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 ModName
_ DataRepr'
dataRepr Int
_size Maybe [ModName]
_labels [(Integer, HWType)]
tys) Modifier
_ [Expr]
es) |
  DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr =
  DataRepr'
-> ConstrRepr'
-> [(HWType, Expr)]
-> Mon (State SystemVerilogState) 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 ModName
_ Maybe [ModName]
_ [HWType]
tys) Modifier
_ [Expr]
es) = Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((HWType -> Expr -> Mon (State SystemVerilogState) Doc)
-> [HWType] -> [Expr] -> Mon (State SystemVerilogState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV [HWType]
tys [Expr]
es)

expr_ Bool
_ (DataCon (Enable ModName
_) Modifier
_ [Expr
e]) =
  Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e

expr_ Bool
_ (BlackBoxE ModName
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((ModName, ModName), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | ModName
pNm ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
"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 -> Mon (State SystemVerilogState) 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 ModName
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((ModName, ModName), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | ModName
pNm ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
"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 -> Mon (State SystemVerilogState) 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 ModName
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((ModName, ModName), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | ModName
pNm ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
"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 -> Mon (State SystemVerilogState) 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 ModName
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((ModName, ModName), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | ModName
pNm ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
"Clash.Sized.Internal.BitVector.fromInteger##"
  , [Literal Maybe (HWType, Int)
_ Literal
m, Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = let NumLit Integer
m' = Literal
m
        NumLit Integer
i' = Literal
i
    in Maybe (HWType, Int)
-> Literal -> Mon (State SystemVerilogState) 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 ModName
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((ModName, ModName), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | ModName
pNm ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
"Clash.Sized.Internal.Index.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int)
-> Literal -> Mon (State SystemVerilogState) 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),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) Literal
i

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

expr_ Bool
_ (DataTag HWType
Bool (Left Identifier
id_))          = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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
  Mon (State SystemVerilogState) Doc
"$unsigned" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State SystemVerilogState) [Doc]
-> Mon (State SystemVerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ([Mon (State SystemVerilogState) Doc]
-> Mon (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
iwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces Mon (State SystemVerilogState) Doc
"1'b0"),Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_]))

expr_ Bool
_ (DataTag (Sum ModName
_ [ModName]
_) (Left Identifier
id_))     = Mon (State SystemVerilogState) Doc
"$unsigned" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)
expr_ Bool
_ (DataTag (Sum ModName
_ [ModName]
_) (Right Identifier
id_))    = Mon (State SystemVerilogState) Doc
"$unsigned" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"'sd0"

expr_ Bool
_ (DataTag hty :: HWType
hty@(SP ModName
_ [(ModName, [HWType])]
_) (Right Identifier
id_)) = Mon (State SystemVerilogState) Doc
"$unsigned" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens
                                               (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets
                                               (Int -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State SystemVerilogState) 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 -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"'sd0"
expr_ Bool
_ (DataTag (Vector Int
_ HWType
_) (Right Identifier
_)) = do
  Int
iw <- State SystemVerilogState Int -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"'sd1"

expr_ Bool
_ (DataTag (RTree Int
0 HWType
_) (Right Identifier
_)) = do
  Int
iw <- State SystemVerilogState Int -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"'sd0"
expr_ Bool
_ (DataTag (RTree Int
_ HWType
_) (Right Identifier
_)) = do
  Int
iw <- State SystemVerilogState Int -> Mon (State SystemVerilogState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Int
 -> Mon (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Mon (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 -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"'sd1"

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

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

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

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

exprLitSV :: Maybe (HWType,Size) -> Literal -> SystemVerilogM Doc
exprLitSV :: Maybe (HWType, Int)
-> Literal -> Mon (State SystemVerilogState) Doc
exprLitSV = Lens' SystemVerilogState (Maybe (Maybe Int))
-> Maybe (HWType, Int)
-> Literal
-> Mon (State SystemVerilogState) Doc
forall s.
Lens' s (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Mon (State s) Doc
exprLit 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 (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 -> Mon (State SystemVerilogState) Doc
toSLV HWType
t Expr
e = case HWType
t of
  Vector Int
_ HWType
_ -> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> Mon (State SystemVerilogState) Doc
verilogTypeMark HWType
t Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_to_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e))
  RTree Int
_ HWType
_ -> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> Mon (State SystemVerilogState) Doc
verilogTypeMark HWType
t Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_to_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e))
  HWType
_ -> Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e

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

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

expFromSLV :: HWType -> SystemVerilogM Doc -> SystemVerilogM Doc
expFromSLV :: HWType
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
expFromSLV t :: HWType
t@(Vector Int
_ HWType
_) Mon (State SystemVerilogState) Doc
exp_ = HWType -> Mon (State SystemVerilogState) Doc
verilogTypeMark HWType
t Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_from_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
exp_
expFromSLV t :: HWType
t@(RTree Int
_ HWType
_) Mon (State SystemVerilogState) Doc
exp_ = HWType -> Mon (State SystemVerilogState) Doc
verilogTypeMark HWType
t Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
"_from_lv" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
exp_
expFromSLV (Signed Int
_) Mon (State SystemVerilogState) Doc
exp_ = Mon (State SystemVerilogState) Doc
"$signed" Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State SystemVerilogState) Doc
exp_
expFromSLV HWType
_ Mon (State SystemVerilogState) Doc
exp_ = Mon (State SystemVerilogState) 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 :: 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 :: 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 => Mon m Doc -> Mon m [Doc] -> Mon m Doc
punctuate' :: Mon m Doc -> Mon m [Doc] -> Mon m Doc
punctuate' Mon m Doc
s Mon m [Doc]
d = Mon m [Doc] -> Mon m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon m Doc -> Mon m [Doc] -> Mon m [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon m Doc
s Mon m [Doc]
d) Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
s


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 ModName
_ [(ModName, [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   = (ModName, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((ModName, [HWType]) -> [HWType])
-> (ModName, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(ModName, [HWType])]
args [(ModName, [HWType])] -> Int -> (ModName, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI
    argTy :: HWType
argTy    = [HWType]
argTys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI
    argSize :: Int
argSize  = HWType -> Int
typeSize HWType
argTy
    other :: Int
other    = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-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 ModName
_ Maybe [ModName]
_ [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. [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 ModName
typName DataRepr'
_dataRepr Int
_size [(ConstrRepr', ModName, [HWType])]
args,Int
dcI,Int
fI)) =
  case Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. [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)]
_ ->
      String -> Maybe ([Either NMod NMod], HWType)
forall a. HasCallStack => String -> a
error (String -> Maybe ([Either NMod NMod], HWType))
-> String -> Maybe ([Either NMod NMod], HWType)
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Cannot handle projection out of a "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"non-contiguously or zero-width encoded field. Tried to project "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
fI String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of constructor " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
dcI String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"data type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModName -> String
forall a. Show a => a -> String
show ModName
typName String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"."
 where
  (ConstrRepr' ModName
_name Int
_n Integer
_mask Integer
_value [Integer]
anns, ModName
_, [HWType]
argTys) = [(ConstrRepr', ModName, [HWType])]
args [(ConstrRepr', ModName, [HWType])]
-> Int -> (ConstrRepr', ModName, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI
  argTy :: HWType
argTy = [HWType]
argTys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI

modifier Int
offset [Either NMod NMod]
mods (Indexed (CustomProduct ModName
typName DataRepr'
dataRepr Int
_size Maybe [ModName]
_maybeFieldNames [(Integer, HWType)]
args,Int
dcI,Int
fI))
  | DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr
  , ConstrRepr' ModName
_cName Int
_pos Integer
_mask Integer
_val [Integer]
fieldAnns <- ConstrRepr'
cRepr =
  case Integer -> [(Int, Int)]
bitRanges ([Integer]
fieldAnns [Integer] -> Int -> Integer
forall a. [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)]
_ ->
      String -> Maybe ([Either NMod NMod], HWType)
forall a. HasCallStack => String -> a
error (String -> Maybe ([Either NMod NMod], HWType))
-> String -> Maybe ([Either NMod NMod], HWType)
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Cannot handle projection out of a "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"non-contiguously or zero-width encoded field. Tried to project "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
fI String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of constructor " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
dcI String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"data type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModName -> String
forall a. Show a => a -> String
show ModName
typName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
 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. [a] -> Int -> a
!! Int
fI

modifier Int
offset [Either NMod NMod]
mods (DC (ty :: HWType
ty@(SP ModName
_ [(ModName, [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