{-|
  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 qualified Data.HashMap.Strict                  as HashMapS
import           Data.HashSet                         (HashSet)
import qualified Data.HashSet                         as HashSet
import           Data.List                            (nub, nubBy)
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 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.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           Clash.Netlist.Id                     (IdType (..), mkBasicId')
import           Clash.Netlist.Types                  hiding (_intWidth, intWidth)
import           Clash.Netlist.Util                   hiding (mkIdentifier, extendIdentifier)
import           Clash.Signal.Internal                (ActiveEdge (..))
import           Clash.Util
  (SrcSpan, noSrcSpan, curLoc, makeCached, (<:>), first, on, traceIf, 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 Identifier Word
_tySeen    :: HashMapS.HashMap Identifier Word -- ^ Product type counter
    , SystemVerilogState -> HashMap HWType Doc
_nameCache :: HashMap HWType Doc -- ^ Cache for previously generated product type names
    , SystemVerilogState -> Int
_genDepth  :: Int -- ^ Depth of current generative block
    , SystemVerilogState -> Identifier
_modNm     :: Identifier
    , SystemVerilogState -> HashMap Identifier Word
_idSeen    :: HashMapS.HashMap Identifier Word
    , 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 -> Bool
_escapedIds :: Bool
    , SystemVerilogState -> Maybe (Maybe Int)
_undefValue :: Maybe (Maybe Int)
    }

makeLenses ''SystemVerilogState

instance Backend SystemVerilogState where
  initBackend :: Int -> HdlSyn -> Bool -> Maybe (Maybe Int) -> SystemVerilogState
initBackend     = HashSet HWType
-> HashMap Identifier Word
-> HashMap HWType Doc
-> Int
-> Identifier
-> HashMap Identifier Word
-> [Identifier]
-> SrcSpan
-> [(String, Doc)]
-> [Text]
-> [Text]
-> [(String, String)]
-> [(String, String)]
-> Bool
-> Int
-> HdlSyn
-> Bool
-> Maybe (Maybe Int)
-> SystemVerilogState
SystemVerilogState HashSet HWType
forall a. HashSet a
HashSet.empty HashMap Identifier Word
forall k v. HashMap k v
HashMapS.empty HashMap HWType Doc
forall k v. HashMap k v
HashMap.empty
                                       0 "" HashMap Identifier Word
forall k v. HashMap k v
HashMapS.empty [] SrcSpan
noSrcSpan [] [] []
                                       [] [] Bool
False
  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.</> "common"
                                      , String
root String -> String -> String
System.FilePath.</> "commonverilog"
                                      , String
root String -> String -> String
System.FilePath.</> "systemverilog"
                                      ]
  extractTypes :: SystemVerilogState -> HashSet HWType
extractTypes    = SystemVerilogState -> HashSet HWType
_tyCache
  name :: SystemVerilogState -> String
name            = String -> SystemVerilogState -> String
forall a b. a -> b -> a
const "systemverilog"
  extension :: SystemVerilogState -> String
extension       = String -> SystemVerilogState -> String
forall a b. a -> b -> a
const ".sv"

  genHDL :: Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
genHDL          = Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
genVerilog
  mkTyPackage :: Identifier
-> [HWType] -> Mon (State SystemVerilogState) [(String, Doc)]
mkTyPackage     = Identifier
-> [HWType] -> Mon (State SystemVerilogState) [(String, Doc)]
mkTyPackage_
  hdlType :: Usage -> HWType -> Mon (State SystemVerilogState) Doc
hdlType _       = 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 t :: Text
t ty :: 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 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 ()
+= 1
                       if Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                          then State SystemVerilogState Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
                          else "generate"
  genStmt 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 ()
-= 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
> 0
                          then State SystemVerilogState Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
                          else "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 hty :: HWType
hty id_ :: Text
id_    = HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV HWType
hty (Identifier -> Maybe Modifier -> Expr
Identifier (Text -> Identifier
Text.toStrict Text
id_) Maybe Modifier
forall a. Maybe a
Nothing)
  fromBV :: HWType -> Text -> Mon (State SystemVerilogState) Doc
fromBV hty :: HWType
hty id_ :: Text
id_  = HWType -> Identifier -> Mon (State SystemVerilogState) Doc
simpleFromSLV HWType
hty (Text -> Identifier
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
  mkIdentifier :: State SystemVerilogState (IdType -> Identifier -> Identifier)
mkIdentifier    = do
      Bool
allowEscaped <- Getting Bool SystemVerilogState Bool
-> StateT SystemVerilogState Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool SystemVerilogState Bool
Lens' SystemVerilogState Bool
escapedIds
      (IdType -> Identifier -> Identifier)
-> State SystemVerilogState (IdType -> Identifier -> Identifier)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool -> IdType -> Identifier -> Identifier
go Bool
allowEscaped)
    where
      go :: Bool -> IdType -> Identifier -> Identifier
go _ Basic nm :: Identifier
nm = case (Int -> Identifier -> Identifier
TextS.take 1024 (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
filterReserved) (HDL -> Bool -> Identifier -> Identifier
mkBasicId' HDL
SystemVerilog Bool
True Identifier
nm) of
        nm' :: Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> "_clash_internal"
            | Bool
otherwise -> Identifier
nm'
      go esc :: Bool
esc Extended (Identifier -> Identifier
rmSlash (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
escapeTemplate -> Identifier
nm) = case Bool -> IdType -> Identifier -> Identifier
go Bool
esc IdType
Basic Identifier
nm of
        nm' :: Identifier
nm' | Bool
esc Bool -> Bool -> Bool
&& Identifier
nm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
nm' -> [Identifier] -> Identifier
TextS.concat ["\\",Identifier
nm," "]
            | Bool
otherwise -> Identifier
nm'
  extendIdentifier :: State
  SystemVerilogState
  (IdType -> Identifier -> Identifier -> Identifier)
extendIdentifier = do
      Bool
allowEscaped <- Getting Bool SystemVerilogState Bool
-> StateT SystemVerilogState Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool SystemVerilogState Bool
Lens' SystemVerilogState Bool
escapedIds
      (IdType -> Identifier -> Identifier -> Identifier)
-> State
     SystemVerilogState
     (IdType -> Identifier -> Identifier -> Identifier)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool -> IdType -> Identifier -> Identifier -> Identifier
go Bool
allowEscaped)
    where
      go :: Bool -> IdType -> Identifier -> Identifier -> Identifier
go _ Basic nm :: Identifier
nm ext :: Identifier
ext =
        case (Int -> Identifier -> Identifier
TextS.take 1024 (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
filterReserved) (HDL -> Bool -> Identifier -> Identifier
mkBasicId' HDL
SystemVerilog Bool
True (Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
ext)) of
          nm' :: Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> "_clash_internal"
              | Bool
otherwise -> Identifier
nm'
      go esc :: Bool
esc Extended (Identifier -> Identifier
rmSlash -> Identifier
nm) ext :: Identifier
ext =
        let nmExt :: Identifier
nmExt = Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
ext
        in  case Bool -> IdType -> Identifier -> Identifier -> Identifier
go Bool
esc IdType
Basic Identifier
nm Identifier
ext of
              nm' :: Identifier
nm' | Bool
esc Bool -> Bool -> Bool
&& Identifier
nm' Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
nmExt -> case Identifier -> Identifier -> Bool
TextS.isPrefixOf "c$" Identifier
nmExt of
                      True -> [Identifier] -> Identifier
TextS.concat ["\\",Identifier
nmExt," "]
                      _    -> [Identifier] -> Identifier
TextS.concat ["\\c$",Identifier
nmExt," "]
                  | Bool
otherwise -> Identifier
nm'

  setModName :: Identifier -> SystemVerilogState -> SystemVerilogState
setModName nm :: Identifier
nm s :: SystemVerilogState
s = SystemVerilogState
s {_modNm :: Identifier
_modNm = Identifier
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 _ ds :: [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
  unextend :: State SystemVerilogState (Identifier -> Identifier)
unextend = (Identifier -> Identifier)
-> State SystemVerilogState (Identifier -> Identifier)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier -> Identifier
rmSlash
  addIncludes :: [(String, Doc)] -> State SystemVerilogState ()
addIncludes inc :: [(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 libs :: [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 inps :: [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 f :: 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 (fs' :: [(String, String)]
fs',f' :: 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 f :: (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
  seenIdentifiers :: (HashMap Identifier Word -> f (HashMap Identifier Word))
-> SystemVerilogState -> f SystemVerilogState
seenIdentifiers = (HashMap Identifier Word -> f (HashMap Identifier Word))
-> SystemVerilogState -> f SystemVerilogState
Lens' SystemVerilogState (HashMap Identifier Word)
idSeen
  ifThenElseExpr :: SystemVerilogState -> Bool
ifThenElseExpr _ = Bool
True

rmSlash :: Identifier -> Identifier
rmSlash :: Identifier -> Identifier
rmSlash nm :: Identifier
nm = Identifier -> Maybe Identifier -> Identifier
forall a. a -> Maybe a -> a
fromMaybe Identifier
nm (Maybe Identifier -> Identifier) -> Maybe Identifier -> Identifier
forall a b. (a -> b) -> a -> b
$ do
  Identifier
nm1 <- Identifier -> Identifier -> Maybe Identifier
TextS.stripPrefix "\\" Identifier
nm
  Identifier -> Maybe Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Char -> Bool) -> Identifier -> Identifier
TextS.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ')) Identifier
nm1)

type SystemVerilogM a = Mon (State SystemVerilogState) a

-- List of reserved SystemVerilog-2012 keywords
reservedWords :: [Identifier]
reservedWords :: [Identifier]
reservedWords = ["accept_on","alias","always","always_comb","always_ff"
  ,"always_latch","and","assert","assign","assume","automatic","before","begin"
  ,"bind","bins","binsof","bit","break","buf","bufif0","bufif1","byte","case"
  ,"casex","casez","cell","chandle","checker","class","clocking","cmos","config"
  ,"const","constraint","context","continue","cover","covergroup","coverpoint"
  ,"cross","deassign","default","defparam","design","disable","dist","do","edge"
  ,"else","end","endcase","endchecker","endclass","endclocking","endconfig"
  ,"endfunction","endgenerate","endgroup","endinterface","endmodule","endpackage"
  ,"endprimitive","endprogram","endproperty","endspecify","endsequence"
  ,"endtable","endtask","enum","event","eventually","expect","export","extends"
  ,"extern","final","first_match","for","force","foreach","forever","fork"
  ,"forkjoin","function","generate","genvar","global","highz0","highz1","if"
  ,"iff","ifnone","ignore_bins","illegal_bins","implements","implies","import"
  ,"incdir","include","initial","inout","input","inside","instance","int"
  ,"integer","interconnect","interface","intersect","join","join_any"
  ,"join_none","large","let","liblist","library","local","localparam","logic"
  ,"longint","macromodule","matches","medium","modport","module","nand"
  ,"negedge","nettype","new","nexttime","nmos","nor","noshowcancelled","not"
  ,"notif0","notif1","null","or","output","package","packed","parameter","pmos"
  ,"posedge","primitive","priority","program","property","protected","pull0"
  ,"pull1","pulldown","pullup","pulsestyle_ondetect","pulsestyle_onevent"
  ,"pure","rand","randc","randcase","randsequence","rcmos","real","realtime"
  ,"ref","reg","reject_on","release","repeat","restrict","return","rnmos"
  ,"rpmos","rtran","rtranif0","rtranif1","s_always","s_eventually","s_nexttime"
  ,"s_until","s_until_with","scalared","sequence","shortint","shortreal"
  ,"showcancelled","signed","small","soft","solve","specify","specparam"
  ,"static","string","strong","strong0","strong1","struct","super","supply0"
  ,"supply1","sync_accept_on","sync_reject_on","table","tagged","task","this"
  ,"throughout","time","timeprecision","timeunit","tran","tranif0","tranif1"
  ,"tri","tri0","tri1","triand","trior","trireg","type","typedef","union"
  ,"unique","unique0","unsigned","until","until_with","untyped","use","uwire"
  ,"var","vectored","virtual","void","wait","wait_order","wand","weak","weak0"
  ,"weak1","while","wildcard","wire","with","within","wor","xnor","xor"]

filterReserved :: Identifier -> Identifier
filterReserved :: Identifier -> Identifier
filterReserved s :: Identifier
s = if Identifier
s Identifier -> [Identifier] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Identifier]
reservedWords
  then Identifier
s Identifier -> Identifier -> Identifier
`TextS.append` "_r"
  else Identifier
s

-- | Generate SystemVerilog for a Netlist component
genVerilog :: Identifier -> SrcSpan -> HashMapS.HashMap Identifier Word -> Component -> SystemVerilogM ((String,Doc),[(String,Doc)])
genVerilog :: Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
genVerilog _ sp :: SrcSpan
sp seen :: HashMap Identifier Word
seen c :: Component
c = Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
forall s a. Backend s => Mon (State s) a -> Mon (State s) a
preserveSeen (Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
 -> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)]))
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
-> Mon (State SystemVerilogState) ((String, Doc), [(String, Doc)])
forall a b. (a -> b) -> a -> b
$ 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
$ (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashMap Identifier Word)
idSeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> HashMap Identifier Word -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= HashMap Identifier Word
seen
    -- Don't have type names conflict with module names
    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
$ (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashMap Identifier Word)
tySeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Word -> Word -> Word)
-> HashMap Identifier Word
-> HashMap Identifier Word
-> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMapS.unionWith Word -> Word -> Word
forall a. Ord a => a -> a -> a
max HashMap Identifier Word
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 ((Identifier -> String
TextS.unpack 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
         = "/* 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
<> "** 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
<> ". 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
<> "*/"
    timescale :: Mon (State SystemVerilogState) Doc
timescale = "`timescale 100fs/100fs"

-- | Generate a SystemVerilog package containing type definitions for the given HWTypes
mkTyPackage_ :: Identifier
             -> [HWType]
             -> SystemVerilogM [(String,Doc)]
mkTyPackage_ :: Identifier
-> [HWType] -> Mon (State SystemVerilogState) [(String, Doc)]
mkTyPackage_ modName :: Identifier
modName hwtys :: [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.<$> (Identifier -> String
TextS.unpack Identifier
modName String -> String -> String
forall a. [a] -> [a] -> [a]
++ "_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.<$>
       "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
<> "_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 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 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
<>
       "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
<> "_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    = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
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 n :: Int
n ty1 :: HWType
ty1) (Vector m :: Int
m ty2 :: 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 n :: Int
n ty1 :: HWType
ty1) (RTree m :: Int
m ty2 :: 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 Bit  ty2 :: 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 Bool ty2 :: 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 ty1 :: HWType
ty1 ty2 :: 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 _)        = Bool
True
    isUnsigned (BitVector _)       = Bool
True
    isUnsigned (Index _)           = Bool
True
    isUnsigned (Sum _ _)           = Bool
True
    isUnsigned (CustomSum _ _ _ _) = Bool
True
    isUnsigned (SP _ _)            = Bool
True
    isUnsigned (CustomSP _ _ _ _)  = Bool
True
    isUnsigned _                   = Bool
False

mkUsedTys :: HWType
        -> [HWType]
mkUsedTys :: HWType -> [HWType]
mkUsedTys v :: HWType
v@(Vector _ elTy :: HWType
elTy)     = HWType
v HWType -> [HWType] -> [HWType]
forall a. a -> [a] -> [a]
: HWType -> [HWType]
mkUsedTys HWType
elTy
mkUsedTys t :: HWType
t@(RTree _ elTy :: HWType
elTy)      = HWType
t HWType -> [HWType] -> [HWType]
forall a. a -> [a] -> [a]
: HWType -> [HWType]
mkUsedTys HWType
elTy
mkUsedTys p :: HWType
p@(Product _ _ elTys :: [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 _ elTys :: [(Identifier, [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 (((Identifier, [HWType]) -> [HWType])
-> [(Identifier, [HWType])] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Identifier, [HWType])]
elTys)
mkUsedTys t :: HWType
t                     = [HWType
t]

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

    edge :: HWType -> [(Int, Int)]
edge t :: HWType
t@(Vector _ elTy :: 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 _ elTy :: 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 _ _ tys :: [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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Product") HWType
t HashMap HWType Int
nodesI
                               in (HWType -> Maybe (Int, Int)) -> [HWType] -> [(Int, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ty :: 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 _ ctys :: [(Identifier, [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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "SP") HWType
t HashMap HWType Int
nodesI
                             in ((Identifier, [HWType]) -> [(Int, Int)])
-> [(Identifier, [HWType])] -> [(Int, Int)]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (\(_,tys :: [HWType]
tys) -> (HWType -> Maybe (Int, Int)) -> [HWType] -> [(Int, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ty :: 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) [(Identifier, [HWType])]
ctys
    edge _                 = []

normaliseType :: HWType -> SystemVerilogM HWType
normaliseType :: HWType -> Mon (State SystemVerilogState) HWType
normaliseType (Annotated _ ty :: HWType
ty) = HWType -> Mon (State SystemVerilogState) HWType
normaliseType HWType
ty
normaliseType (Vector n :: Int
n ty :: 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 d :: Int
d ty :: 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 nm :: Identifier
nm lbls :: Maybe [Identifier]
lbls tys :: [HWType]
tys) = Identifier -> Maybe [Identifier] -> [HWType] -> HWType
Product Identifier
nm Maybe [Identifier]
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 _ elTys :: [(Identifier, [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) (((Identifier, [HWType]) -> [HWType])
-> [(Identifier, [HWType])] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Identifier, [HWType])]
elTys)
  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 _ _dataRepr :: DataRepr'
_dataRepr size :: Int
size elTys :: [(ConstrRepr', Identifier, [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 | (_, _, subTys :: [HWType]
subTys) <- [(ConstrRepr', Identifier, [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 _) = 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 _ _) = 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 _ _ _ _) = 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 _) = HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
Bit
normaliseType (Reset {}) = HWType -> Mon (State SystemVerilogState) HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
Bit
normaliseType (BiDirectional dir :: PortDirection
dir ty :: 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 ty :: 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 n :: 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
-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 0)
range (Right n :: 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 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
-1))

tyDec :: HWType -> SystemVerilogM (Maybe Doc)
tyDec :: HWType -> Mon (State SystemVerilogState) (Maybe Doc)
tyDec ty :: HWType
ty@(Vector n :: Int
n elTy :: HWType
elTy) | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
    Vivado -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
      Just ([Right n' :: Int
n',Left n'' :: Int
n''],elTy' :: Mon (State SystemVerilogState) Doc
elTy') ->
        "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
-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 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 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
-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
      _ ->
        "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
<+> "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
- 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 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 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
-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
    _ -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
      Just (Right n' :: Int
n':ns :: [Either Int Int]
ns,elTy' :: Mon (State SystemVerilogState) Doc
elTy') ->
        "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 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
- 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
      _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "impossible"
tyDec ty :: HWType
ty@(RTree n :: Int
n elTy :: HWType
elTy) | HWType -> Int
typeSize HWType
elTy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
    Vivado -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
      Just ([Right n' :: Int
n',Left n'' :: Int
n''],elTy' :: Mon (State SystemVerilogState) Doc
elTy') -> -- n' == 2^n
        "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 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
-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 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
-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
      _ ->
        "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
<+> "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
- 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 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 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 (2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)) 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
    _ -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
      Just (Right n' :: Int
n':ns :: [Either Int Int]
ns,elTy' :: Mon (State SystemVerilogState) Doc
elTy') -> -- n' == 2^n
        "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 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
- 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
      _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "impossible"
tyDec ty :: HWType
ty@(Product _ _ tys :: [HWType]
tys) | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 = "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 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
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 x :: Mon (State SystemVerilogState) Doc
x y :: HWType
y = do
      Maybe Doc
yM <- HWType -> Mon (State SystemVerilogState) (Maybe Doc)
lvType HWType
y
      case Maybe Doc
yM of
        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 y' :: 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 (\i :: 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
<> "_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) [0..]

tyDec _ = 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 (ns :: [Either Int b]
ns,t :: 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "impossible"
      Clock {}   -> ([Either Int b]
ns, HWType -> Mon (State SystemVerilogState) Doc
verilogType HWType
t)
      Reset {}   -> ([Either Int b]
ns, "logic")
      Bool       -> ([Either Int b]
ns, "logic")
      Bit        -> ([Either Int b]
ns, "logic")
      String     -> ([Either Int b]
ns, "string")
      Signed n :: 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],"logic signed")
      _          -> ([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)], "logic")

    go :: HWType -> Maybe ([Either a Int], HWType)
go (Vector n :: Int
n elTy :: HWType
elTy) = case HWType -> Maybe ([Either a Int], HWType)
go HWType
elTy of
      Just (ns :: [Either a Int]
ns,elTy' :: 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')
      _               -> ([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 n :: Int
n elTy :: HWType
elTy) = let n' :: Int
n' = 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 (ns :: [Either a Int]
ns,elTy' :: 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')
      _               -> ([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 _ = 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 n :: Int
n elTy :: HWType
elTy) | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
    Vivado -> "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 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
-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
- 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 0)
    _ -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
      Just (ns :: [Either Int Int]
ns,elTy' :: 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)
      _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "impossible"
lvType ty :: HWType
ty@(RTree n :: Int
n elTy :: HWType
elTy) | HWType -> Int
typeSize HWType
elTy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
    Vivado -> "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 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 (2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)) 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
- 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 0)
    _ -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
      Just (ns :: [Either Int Int]
ns,elTy' :: 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)
      _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "impossible"
lvType ty :: HWType
ty | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 _ = 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 n :: Int
n elTy :: HWType
elTy) | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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.<$>
  "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
<+> "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
<+> "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
<> "_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 "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 2
    ("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 ("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
<+> "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
<+> "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 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
<> "_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 "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f 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
<>
  "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
<>
  "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
<+> "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
<> "_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 ("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
<+> "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 2
    ("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 ("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
<+> "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
<+> "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 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
<> "_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 "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f 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
<>
  "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
> 1 then
    "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
<+> "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
<> "_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 "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 "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 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
<> "_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 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
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 "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
<> "_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 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
-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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f 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
<>
    "endfunction"
  else
    "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
<+> "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
<> "_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 "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 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
<> "_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 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
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 "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
<>
    "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 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
-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
- 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 0)

    vecSigDecl :: SystemVerilogM Doc -> SystemVerilogM Doc
    vecSigDecl :: Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
vecSigDecl d :: 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
        Vivado -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
          Just ([Right n' :: Int
n',Left n'' :: Int
n''],elTy' :: 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 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
-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 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
-2))
          _ ->
            "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
- 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 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 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
-2))
        _ -> case HWType
-> Maybe ([Either Int Int], Mon (State SystemVerilogState) Doc)
splitVecTy HWType
ty of
         Just (Right n' :: Int
n':ns :: [Either Int Int]
ns,elTy' :: 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 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
- 2))
         _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "impossible"


funDec ty :: HWType
ty@(RTree n :: Int
n elTy :: HWType
elTy) | HWType -> Int
typeSize HWType
elTy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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.<$>
  "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
<+> "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
<+> "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
<> "_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 "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 2
    ("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 ("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
<+> "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 (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
<+> "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 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
<> "_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 "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f 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
<>
  "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
<>
  "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
<+> "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
<> "_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 ("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
<+> "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 2
    ("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 ("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
<+> "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 (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
<+> "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 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
<> "_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 "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f 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
<>
  "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
> 0
      then
        "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
<+> "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
<> "_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 "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 "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 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
<> "_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 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 (2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)Int -> Int -> Int
forall a. Num a => a -> a -> a
-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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f 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
<> "_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 (2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)) 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 (2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)) 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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f 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
<>
        "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 d :: 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
        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
-1) HWType
elTy) of
          Just ([Right n' :: Int
n',Left n'' :: Int
n''],elTy' :: 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 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
-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 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
- 1))
          _ ->
            "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
- 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 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 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 (2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)Int -> Int -> Int
forall a. Num a => a -> a -> a
-1))
        _ -> 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
-1) HWType
elTy) of
          Just (Right n' :: Int
n':ns :: [Either Int Int]
ns,elTy' :: 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 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
- 1))
          _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 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 (2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)) 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
- 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 0)

funDec _ = 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_ c :: Component
c =
  Component -> Mon (State SystemVerilogState) ()
addSeen Component
c Mon (State SystemVerilogState) ()
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> 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  = "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). Applicative f => Identifier -> f Doc
stringS (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 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 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 2 ([Declaration] -> Mon (State SystemVerilogState) Doc
insts (Component -> [Declaration]
declarations Component
c))
  modEnding :: Mon (State SystemVerilogState) Doc
modEnding  = "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.
(Maybe a, Bool)
-> (Identifier, 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 | (i :: Identifier
i,ty :: 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.
(Maybe a, Bool)
-> (Identifier, 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 | (wr :: WireOrReg
wr, p :: (Identifier, HWType)
p, iEM :: Maybe Expr
iEM) <- Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c ]

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

  -- map a port to its verilog type, port name, and any encoding notes
  sigPort :: (Maybe a, Bool)
-> (Identifier, 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) (nm :: Identifier
nm, hwTy :: HWType
hwTy) iEM :: 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 (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
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 v :: 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 v :: 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 "// 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
    (x :: Doc
x:xs :: [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 "// 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 "  " 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 v :: 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 "  // 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
    (x :: Doc
x:xs :: [Doc]
xs) -> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string "  // 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
> 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 "  " 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

addSeen :: Component -> SystemVerilogM ()
addSeen :: Component -> Mon (State SystemVerilogState) ()
addSeen c :: Component
c = do
  let iport :: [Identifier]
iport = ((Identifier, HWType) -> Identifier)
-> [(Identifier, HWType)] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, HWType) -> Identifier
forall a b. (a, b) -> a
fst (Component -> [(Identifier, HWType)]
inputs Component
c)
      oport :: [Identifier]
oport = ((WireOrReg, (Identifier, HWType), Maybe Expr) -> Identifier)
-> [(WireOrReg, (Identifier, HWType), Maybe Expr)] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier, HWType) -> Identifier
forall a b. (a, b) -> a
fst ((Identifier, HWType) -> Identifier)
-> ((WireOrReg, (Identifier, HWType), Maybe Expr)
    -> (Identifier, HWType))
-> (WireOrReg, (Identifier, HWType), Maybe Expr)
-> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(_,x :: (Identifier, HWType)
x,_)->(Identifier, HWType)
x)) ([(WireOrReg, (Identifier, HWType), Maybe Expr)] -> [Identifier])
-> [(WireOrReg, (Identifier, HWType), Maybe Expr)] -> [Identifier]
forall a b. (a -> b) -> a -> b
$ Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c
      nets :: [Identifier]
nets  = (Declaration -> Maybe Identifier) -> [Declaration] -> [Identifier]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case {NetDecl' _ _ i :: Identifier
i _ _ -> Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
i; _ -> Maybe Identifier
forall a. Maybe a
Nothing}) ([Declaration] -> [Identifier]) -> [Declaration] -> [Identifier]
forall a b. (a -> b) -> a -> b
$ Component -> [Declaration]
declarations Component
c
  State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashMap Identifier Word)
idSeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Word -> Word -> Word)
-> HashMap Identifier Word
-> HashMap Identifier Word
-> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMapS.unionWith Word -> Word -> Word
forall a. Ord a => a -> a -> a
max ([(Identifier, Word)] -> HashMap Identifier Word
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMapS.fromList (([Identifier] -> [(Identifier, Word)])
-> [[Identifier]] -> [(Identifier, Word)]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap ((Identifier -> (Identifier, Word))
-> [Identifier] -> [(Identifier, Word)]
forall a b. (a -> b) -> [a] -> [b]
map (,0)) [[Identifier]
iport,[Identifier]
oport,[Identifier]
nets]))))
  State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (([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 ()
.= [Identifier]
oport)

mkUniqueId :: Identifier -> SystemVerilogM Identifier
mkUniqueId :: Identifier -> SystemVerilogM Identifier
mkUniqueId i :: Identifier
i = do
  Identifier -> Identifier
mkId <- State SystemVerilogState (Identifier -> Identifier)
-> Mon (State SystemVerilogState) (Identifier -> Identifier)
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State SystemVerilogState (IdType -> Identifier -> Identifier)
-> StateT SystemVerilogState Identity IdType
-> State SystemVerilogState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT SystemVerilogState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Extended)
  HashMap Identifier Word
seen <- State SystemVerilogState (HashMap Identifier Word)
-> Mon (State SystemVerilogState) (HashMap Identifier Word)
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState (HashMap Identifier Word)
 -> Mon (State SystemVerilogState) (HashMap Identifier Word))
-> State SystemVerilogState (HashMap Identifier Word)
-> Mon (State SystemVerilogState) (HashMap Identifier Word)
forall a b. (a -> b) -> a -> b
$ Getting
  (HashMap Identifier Word)
  SystemVerilogState
  (HashMap Identifier Word)
-> State SystemVerilogState (HashMap Identifier Word)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (HashMap Identifier Word)
  SystemVerilogState
  (HashMap Identifier Word)
Lens' SystemVerilogState (HashMap Identifier Word)
idSeen
  let i' :: Identifier
i' = Identifier -> Identifier
mkId Identifier
i
  case Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMapS.lookup Identifier
i HashMap Identifier Word
seen of
    Just n :: Word
n -> (Identifier -> Identifier)
-> HashMap Identifier Word
-> Identifier
-> Word
-> SystemVerilogM Identifier
go Identifier -> Identifier
mkId HashMap Identifier Word
seen Identifier
i' Word
n
    Nothing -> do State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashMap Identifier Word)
idSeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMapS.insert Identifier
i' 0))
                  Identifier -> SystemVerilogM Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
i'
  where
    go :: (Identifier -> Identifier) -> HashMapS.HashMap Identifier Word -> Identifier
       -> Word -> SystemVerilogM Identifier
    go :: (Identifier -> Identifier)
-> HashMap Identifier Word
-> Identifier
-> Word
-> SystemVerilogM Identifier
go mkId :: Identifier -> Identifier
mkId seen :: HashMap Identifier Word
seen i' :: Identifier
i' n :: Word
n = do
      let i'' :: Identifier
i'' = Identifier -> Identifier
mkId (Identifier -> Identifier -> Identifier
TextS.append Identifier
i' (String -> Identifier
TextS.pack ('_'Char -> String -> String
forall a. a -> [a] -> [a]
:Word -> String
forall a. Show a => a -> String
show Word
n)))
      case Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMapS.lookup Identifier
i'' HashMap Identifier Word
seen of
        Just _  -> (Identifier -> Identifier)
-> HashMap Identifier Word
-> Identifier
-> Word
-> SystemVerilogM Identifier
go Identifier -> Identifier
mkId HashMap Identifier Word
seen Identifier
i' (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
+1)
        Nothing -> do State SystemVerilogState () -> Mon (State SystemVerilogState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashMap Identifier Word)
idSeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMapS.insert Identifier
i'' (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
+1)))
                      Identifier -> SystemVerilogM Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
i''

verilogType :: HWType -> SystemVerilogM Doc
verilogType :: HWType -> Mon (State SystemVerilogState) Doc
verilogType t_ :: 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 = "wire"
                  | Bool
otherwise      = "logic"
  Bool
pkgCtx <- StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (StateT SystemVerilogState Identity Bool
 -> Mon (State SystemVerilogState) Bool)
-> StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> StateT SystemVerilogState Identity 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
  Identifier
nm <- State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Identifier -> SystemVerilogM Identifier)
-> State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier SystemVerilogState Identifier
-> State SystemVerilogState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier SystemVerilogState Identifier
Lens' SystemVerilogState Identifier
modNm
  let pvrType :: Mon (State SystemVerilogState) Doc
pvrType = if Bool
pkgCtx
                then HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
t
                else Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
nm Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "_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 n :: 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
<+> "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
-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 0)
    Clock _       -> "logic"
    Reset {}      -> "logic"
    Bit           -> "logic"
    Bool          -> "logic"
    String        -> "string"
    FileType      -> "integer"
    _ -> 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
-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 0)

sigDecl :: SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl :: Mon (State SystemVerilogState) Doc
-> HWType -> Mon (State SystemVerilogState) Doc
sigDecl d :: Mon (State SystemVerilogState) Doc
d t :: 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 t_ :: 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 <- StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (StateT SystemVerilogState Identity Bool
 -> Mon (State SystemVerilogState) Bool)
-> StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> StateT SystemVerilogState Identity 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
  Identifier
nm <- State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Identifier -> SystemVerilogM Identifier)
-> State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier SystemVerilogState Identifier
-> State SystemVerilogState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier SystemVerilogState Identifier
Lens' SystemVerilogState Identifier
modNm
  let pvrType :: Mon (State SystemVerilogState) Doc
pvrType = if Bool
pkgCtx
                then HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
t
                else Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
nm Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "_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
    _ -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc

tyName :: HWType -> SystemVerilogM Doc
tyName :: HWType -> Mon (State SystemVerilogState) Doc
tyName Bool                  = "logic"
tyName Bit                   = "logic"
tyName (Vector n :: Int
n elTy :: HWType
elTy)       = "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
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
elTy
tyName (RTree n :: Int
n elTy :: HWType
elTy)        = "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
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State SystemVerilogState) Doc
tyName HWType
elTy
tyName (BitVector n :: Int
n)         = "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 _)           = "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 n :: Int
n)            = "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 n :: Int
n)          = "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 _ _)           = "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 _ _ _ _) = "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 _ _ _ _)  = "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 nm :: Identifier
nm _ _)      = do
  HWType
tN <- HWType -> Mon (State SystemVerilogState) HWType
normaliseType HWType
t
  State SystemVerilogState Doc -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (HWType
-> Lens' SystemVerilogState (HashMap HWType Doc)
-> State SystemVerilogState Doc
-> State SystemVerilogState Doc
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 Doc)
nameCache State SystemVerilogState Doc
prodName)
  where
    prodName :: State SystemVerilogState Doc
prodName = do
      HashMap Identifier Word
seen <- Getting
  (HashMap Identifier Word)
  SystemVerilogState
  (HashMap Identifier Word)
-> State SystemVerilogState (HashMap Identifier Word)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (HashMap Identifier Word)
  SystemVerilogState
  (HashMap Identifier Word)
Lens' SystemVerilogState (HashMap Identifier Word)
tySeen
      Identifier -> Identifier
mkId <- State SystemVerilogState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State SystemVerilogState (IdType -> Identifier -> Identifier)
-> StateT SystemVerilogState Identity IdType
-> State SystemVerilogState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT SystemVerilogState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic
      let nm' :: Identifier
nm'  = (Identifier -> Identifier
mkId (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Identifier] -> Identifier
forall a. [a] -> a
last ([Identifier] -> Identifier)
-> (Identifier -> [Identifier]) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier -> [Identifier]
TextS.splitOn ".") Identifier
nm
          nm'' :: Identifier
nm'' = if Identifier -> Bool
TextS.null Identifier
nm'
                    then "product"
                    else Identifier
nm'
          (nm3 :: Identifier
nm3,count :: Word
count) = case Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMapS.lookup Identifier
nm'' HashMap Identifier Word
seen of
                          Just cnt :: Word
cnt -> (Identifier -> Identifier)
-> HashMap Identifier Word
-> Word
-> Identifier
-> (Identifier, Word)
forall a t v.
(Num a, Show a) =>
t -> HashMap Identifier v -> a -> Identifier -> (Identifier, a)
go Identifier -> Identifier
mkId HashMap Identifier Word
seen Word
cnt Identifier
nm''
                          Nothing  -> (Identifier
nm'',0)
      (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashMap Identifier Word)
tySeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Identifier
nm3 Word
count
      Identifier -> State SystemVerilogState Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
nm3

    go :: t -> HashMap Identifier v -> a -> Identifier -> (Identifier, a)
go mkId :: t
mkId s :: HashMap Identifier v
s i :: a
i n :: Identifier
n =
      let n' :: Identifier
n' = Identifier
n Identifier -> Identifier -> Identifier
`TextS.append` String -> Identifier
TextS.pack ('_'Char -> String -> String
forall a. a -> [a] -> [a]
:a -> String
forall a. Show a => a -> String
show a
i)
      in  case Identifier -> HashMap Identifier v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMapS.lookup Identifier
n' HashMap Identifier v
s of
                 Just _  -> t -> HashMap Identifier v -> a -> Identifier -> (Identifier, a)
go t
mkId HashMap Identifier v
s (a
ia -> a -> a
forall a. Num a => a -> a -> a
+1) Identifier
n
                 Nothing -> (Identifier
n',a
ia -> a -> a
forall a. Num a => a -> a -> a
+1)
tyName t :: HWType
t@(SP _ _) = "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 _)  = "logic"
tyName (Reset {}) = "logic"
tyName t :: 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 n :: Int
n elTy :: 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
    Vivado -> Char -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
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))
    _ -> Char -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
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 n :: Int
n elTy :: 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
    Vivado -> Char -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
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 (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))
    _ -> Char -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
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 (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 String = "\"ERROR\""
verilogTypeErrValue ty :: HWType
ty = HWType -> Mon (State SystemVerilogState) Doc
singularErrValue HWType
ty

singularErrValue :: HWType -> SystemVerilogM Doc
singularErrValue :: HWType -> Mon (State SystemVerilogState) Doc
singularErrValue ty :: 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
    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 "1'bx")
    Just 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
<> "'d0 /* undefined */"
    Just (Just x :: 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 ("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
<+> "/* undefined */"

verilogRecSel
  :: HWType
  -> Int
  -> SystemVerilogM Doc
verilogRecSel :: HWType -> Int -> Mon (State SystemVerilogState) Doc
verilogRecSel ty :: HWType
ty i :: 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
<> "_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 ds :: [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
      _  -> 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' noteM :: Maybe Identifier
noteM _ id_ :: Identifier
id_ tyE :: Either Identifier HWType
tyE iEM :: 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)
-> (Identifier
    -> Mon (State SystemVerilogState) Doc
    -> Mon (State SystemVerilogState) Doc)
-> Maybe Identifier
-> 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 Identifier
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
(Monoid (f Doc), Applicative f, IsString (f Doc)) =>
Identifier -> f Doc -> f Doc
addNote Maybe Identifier
noteM ([Attr']
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
addAttrs [Attr']
attrs (Either Identifier HWType -> Mon (State SystemVerilogState) Doc
typ Either Identifier HWType
tyE))
  where
    typ :: Either Identifier HWType -> Mon (State SystemVerilogState) Doc
typ (Left  ty :: Identifier
ty) = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
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). Applicative f => Identifier -> f Doc
stringS 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 ty :: HWType
ty) = Mon (State SystemVerilogState) Doc
-> HWType -> Mon (State SystemVerilogState) Doc
sigDecl (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 :: Identifier -> f Doc -> f Doc
addNote n :: Identifier
n = f Doc -> f Doc -> f Doc
forall a. Monoid a => a -> a -> a
mappend ("//" f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> f Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
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.<$> (Identifier -> Maybe HWType)
-> (HWType -> Maybe HWType)
-> Either Identifier HWType
-> Maybe HWType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe HWType -> Identifier -> 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 Identifier 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 _ = 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'  key :: String
key value :: 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
forall a. Show a => a -> String
show String
value]
renderAttr (IntegerAttr' key :: String
key value :: 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, " = ", Integer -> String
forall a. Show a => a -> String
show Integer
value]
renderAttr (BoolAttr'    key :: String
key 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, " = ", "1"]
renderAttr (BoolAttr'    key :: String
key 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, " = ", "0"]
renderAttr (Attr'        key :: 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 []     t :: Mon (State SystemVerilogState) Doc
t = Mon (State SystemVerilogState) Doc
t
addAttrs attrs' :: [Attr']
attrs' t :: Mon (State SystemVerilogState) Doc
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
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
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 ", " ((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 id_ :: Identifier
id_:ds :: [Declaration]
ds) = Identifier -> Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
Identifier -> Identifier -> f Doc
comment "//" 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
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 (d :: Declaration
d:ds :: [Declaration]
ds) = do
  Maybe Doc
docM <- Declaration -> Mon (State SystemVerilogState) (Maybe Doc)
inst_ Declaration
d
  case Maybe Doc
docM of
    Nothing -> [Declaration] -> Mon (State SystemVerilogState) Doc
insts [Declaration]
ds
    Just doc :: 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 0 _mask :: a
_mask _value :: a
_value = []
stdMatch size :: Int
size mask :: a
mask value :: a
value =
  Char
symbol Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> a -> a -> String
forall a. Bits a => Int -> a -> a -> String
stdMatch (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) a
mask a
value
  where
    symbol :: Char
symbol =
      if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
mask (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) then
        if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
value (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) then
          '1'
        else
          '0'
      else
        '?'

patLitCustom'
  :: Int
  -> ConstrRepr'
  -> SystemVerilogM Doc
patLitCustom' :: Int -> ConstrRepr' -> Mon (State SystemVerilogState) Doc
patLitCustom' size :: Int
size (ConstrRepr' _name :: Identifier
_name _n :: Int
_n mask :: Integer
mask value :: Integer
value _anns :: [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
<> "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 _name :: Identifier
_name _dataRepr :: DataRepr'
_dataRepr size :: Int
size reprs :: [(ConstrRepr', Identifier)]
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', Identifier) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Identifier) -> ConstrRepr')
-> (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Identifier)]
reprs [(ConstrRepr', Identifier)] -> Int -> (ConstrRepr', Identifier)
forall a. [a] -> Int -> a
!! Int
i)

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

patLitCustom x :: HWType
x y :: 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
  [ "You can only pass CustomSP / CustomSum / CustomProduct and a NumLit to"
  , "this function, not", HWType -> String
forall a. Show a => a -> String
show HWType
x, "and", Literal -> String
forall a. Show a => a -> String
show Literal
y]

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

-- | Helper function for inst_, handling CustomSP and CustomSum
inst_' :: TextS.Text -> Expr -> HWType -> [(Maybe Literal, Expr)] -> SystemVerilogM (Maybe Doc)
inst_' :: Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Mon (State SystemVerilogState) (Maybe Doc)
inst_' id_ :: Identifier
id_ scrut :: Expr
scrut scrutTy :: HWType
scrutTy es :: [(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
$
  "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 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
<> "end"
    where
      casez :: Mon (State SystemVerilogState) Doc
casez =
        "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 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
<>
        "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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Empty list of conditions invalid."
      conds [(_,e :: Expr
e)]           = "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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
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
<> ";"
      conds ((Nothing,e :: Expr
e):_)   = "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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
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
<> ";"
      conds ((Just c :: Literal
c ,e :: Expr
e):es' :: [(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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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
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
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 id_ :: Identifier
id_ e :: 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
$
  "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). Applicative f => Identifier -> f Doc
stringS 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 id_ :: Identifier
id_ ty :: HWType
ty scrut :: Expr
scrut _ [(Just (BoolLit b :: Bool
b), l :: Expr
l),(_,r :: 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 -> SystemVerilogM Identifier
mkUniqueId (Identifier -> SystemVerilogM Identifier)
-> SystemVerilogM Identifier -> SystemVerilogM Identifier
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State
  SystemVerilogState
  (IdType -> Identifier -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier -> Identifier)
extendIdentifier State
  SystemVerilogState
  (IdType -> Identifier -> Identifier -> Identifier)
-> StateT SystemVerilogState Identity IdType
-> StateT
     SystemVerilogState
     Identity
     (Identifier -> Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT SystemVerilogState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Extended StateT
  SystemVerilogState
  Identity
  (Identifier -> Identifier -> Identifier)
-> State SystemVerilogState Identifier
-> State SystemVerilogState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Identifier -> State SystemVerilogState Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Identifier
id_ State SystemVerilogState (Identifier -> Identifier)
-> State SystemVerilogState Identifier
-> State SystemVerilogState Identifier
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Identifier -> State SystemVerilogState Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure "_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). Applicative f => Identifier -> f Doc
stringS 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
<>
                "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 2 ("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 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). Applicative f => Identifier -> f Doc
stringS 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
<>
                         "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 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). Applicative f => Identifier -> f Doc
stringS 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
<>
                "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
<>
                "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). Applicative f => Identifier -> f Doc
stringS 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). Applicative f => Identifier -> f Doc
stringS 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 "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 2 ("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 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). Applicative f => Identifier -> f Doc
stringS 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
<>
                       "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 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). Applicative f => Identifier -> f Doc
stringS 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
<>
              "end"
    }
  where
    (t :: Expr
t,f :: Expr
f) = if Bool
b then (Expr
l,Expr
r) else (Expr
r,Expr
l)

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

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

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

inst_ (CondAssignment id_ :: Identifier
id_ ty :: HWType
ty scrut :: Expr
scrut scrutTy :: HWType
scrutTy es :: [(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 -> SystemVerilogM Identifier
mkUniqueId (Identifier -> SystemVerilogM Identifier)
-> SystemVerilogM Identifier -> SystemVerilogM Identifier
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State
  SystemVerilogState
  (IdType -> Identifier -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier -> Identifier)
extendIdentifier State
  SystemVerilogState
  (IdType -> Identifier -> Identifier -> Identifier)
-> StateT SystemVerilogState Identity IdType
-> StateT
     SystemVerilogState
     Identity
     (Identifier -> Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT SystemVerilogState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Extended StateT
  SystemVerilogState
  Identity
  (Identifier -> Identifier -> Identifier)
-> State SystemVerilogState Identifier
-> State SystemVerilogState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Identifier -> State SystemVerilogState Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Identifier
id_ State SystemVerilogState (Identifier -> Identifier)
-> State SystemVerilogState Identifier
-> State SystemVerilogState Identifier
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Identifier -> State SystemVerilogState Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure "_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). Applicative f => Identifier -> f Doc
stringS 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
<>
             "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 2 ("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 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
<>
                       "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
<>
             "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
<>
             "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). Applicative f => Identifier -> f Doc
stringS 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). Applicative f => Identifier -> f Doc
stringS 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 "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 2 ("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 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
<>
                        "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
<>
              "end"
    }
  where
    conds :: Identifier -> [(Maybe Literal,Expr)] -> SystemVerilogM [Doc]
    conds :: Identifier
-> [(Maybe Literal, Expr)] -> Mon (State SystemVerilogState) [Doc]
conds _ []                = [Doc] -> Mon (State SystemVerilogState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds i :: Identifier
i [(_,e :: Expr
e)]           = ("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). Applicative f => Identifier -> f Doc
stringS 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 i :: Identifier
i ((Nothing,e :: Expr
e):_)   = ("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). Applicative f => Identifier -> f Doc
stringS 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 i :: Identifier
i ((Just c :: Literal
c ,e :: Expr
e):es' :: [(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). Applicative f => Identifier -> f Doc
stringS 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 _ _ nm :: Identifier
nm lbl :: Identifier
lbl ps :: [(Expr, HWType, Expr)]
ps pms :: [(Expr, PortDirection, HWType, Expr)]
pms) = (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
$
    Int
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest 2 (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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). Applicative f => Identifier -> f Doc
stringS 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
pms' 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
    pms' :: Mon (State SystemVerilogState) Doc
pms' = 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 [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) | (i :: Expr
i,_,_,e :: Expr
e) <- [(Expr, PortDirection, HWType, Expr)]
pms]
    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
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) | (i :: Expr
i,_,e :: 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

inst_ (BlackBoxD _ libs :: [BlackBoxTemplate]
libs imps :: [BlackBoxTemplate]
imps inc :: [((Identifier, Identifier), BlackBox)]
inc bs :: BlackBox
bs bbCtx :: 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]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT SystemVerilogState Identity (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx)))

inst_ (Seq ds :: [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'
dataRepr constrRepr :: ConstrRepr'
constrRepr args :: [(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]
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
<> "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 n :: Int
n start :: Int
start end :: Int
end) =
        -- We want to select the bits starting from 'start' downto and including
        -- 'end'. We cannot use 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
+ 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
== 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
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 edge :: ActiveEdge
edge clk :: Expr
clk ds :: [Seq]
ds) =
  "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 {Rising -> "posedge"; _ -> "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
<+> "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 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
<>
  "end"

seq_ (Initial ds :: [Seq]
ds) =
  "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 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
<>
  "end"

seq_ (AlwaysComb ds :: [Seq]
ds) =
  "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 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
<>
  "end"

seq_ (Branch scrut :: Expr
scrut scrutTy :: HWType
scrutTy es :: [(Maybe Literal, [Seq])]
es) =
    "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 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
<>
    "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 [(_,sq :: [Seq]
sq)] =
          ("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
<+> "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 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
<>
          "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 ((Nothing,sq :: [Seq]
sq):_) =
          ("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
<+> "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 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
<>
          "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 c :: Literal
c ,sq :: [Seq]
sq):es' :: [(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
<+> "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 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
<>
          "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 sd :: Declaration
sd) = case Declaration
sd of
  Assignment id_ :: Identifier
id_ e :: Expr
e ->
    Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 ds :: [Seq]
ds ->
    [Seq] -> Mon (State SystemVerilogState) Doc
seqs [Seq]
ds

  _ -> 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 id_ :: Identifier
id_):ds :: [Seq]
ds) = "//" 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). Applicative f => Identifier -> f Doc
stringS 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
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 (d :: Seq
d:ds :: [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_ _ (Literal sizeM :: Maybe (HWType, Int)
sizeM lit :: Literal
lit) = Maybe (HWType, Int)
-> Literal -> Mon (State SystemVerilogState) Doc
exprLitSV Maybe (HWType, Int)
sizeM Literal
lit
expr_ _ (Identifier id_ :: Identifier
id_ Nothing) = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
id_
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed (CustomSP _id :: Identifier
_id dataRepr :: DataRepr'
dataRepr _size :: Int
_size args :: [(ConstrRepr', Identifier, [HWType])]
args,dcI :: Int
dcI,fI :: Int
fI)))) =
  case HWType
fieldTy of
    Void {} ->
      String -> Mon (State SystemVerilogState) Doc
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
    _ ->
      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]
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' _name :: Identifier
_name _n :: Int
_n _mask :: Integer
_mask _value :: Integer
_value anns :: [Integer]
anns, _, fieldTypes :: [HWType]
fieldTypes) = [(ConstrRepr', Identifier, [HWType])]
args [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI
  ranges :: [Mon (State 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' (start :: Int
start, end :: Int
end) = Identifier -> f Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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
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 ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "panic") [HWType]
fieldTypes Int
fI

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed (CustomProduct _id :: Identifier
_id dataRepr :: DataRepr'
dataRepr _size :: Int
_size _maybeFieldNames :: Maybe [Identifier]
_maybeFieldNames args :: [(Integer, HWType)]
args,dcI :: Int
dcI,fI :: 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
-> 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]
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
  (anns :: [Integer]
anns, fieldTypes :: [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' (start :: Int
start, end :: Int
end) = Identifier -> f Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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
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 ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "panic") [HWType]
fieldTypes Int
fI

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed (ty :: HWType
ty@(SP _ args :: [(Identifier, [HWType])]
args),dcI :: Int
dcI,fI :: Int
fI)))) = HWType
-> Identifier -> Int -> Int -> Mon (State SystemVerilogState) Doc
fromSLV HWType
argTy Identifier
id_ Int
start Int
end
  where
    argTys :: [HWType]
argTys   = (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Identifier, [HWType]) -> [HWType])
-> (Identifier, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Identifier, [HWType])]
args [(Identifier, [HWType])] -> Int -> (Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI
    argTy :: HWType
argTy    = [HWType]
argTys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI
    argSize :: Int
argSize  = HWType -> Int
typeSize HWType
argTy
    other :: Int
other    = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
    start :: Int
start    = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
other
    end :: Int
end      = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed (ty :: HWType
ty@(Product _ _ tys :: [HWType]
tys),_,fI :: Int
fI)))) = do
  Identifier
id'<- (Doc -> Identifier)
-> Mon (State SystemVerilogState) Doc -> SystemVerilogM Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
Text.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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
<> "_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 -> Identifier -> Mon (State SystemVerilogState) Doc
simpleFromSLV ([HWType]
tys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI) Identifier
id'

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Vector _ elTy :: HWType
elTy),1,0)))) = do
  Identifier
id' <- (Doc -> Identifier)
-> Mon (State SystemVerilogState) Doc -> SystemVerilogM Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
Text.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 0))
  HWType -> Identifier -> Mon (State SystemVerilogState) Doc
simpleFromSLV HWType
elTy Identifier
id'

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Vector n :: Int
n _),1,1)))) = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 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
-1))

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

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((RTree 0 elTy :: HWType
elTy),0,0)))) = do
  Identifier
id' <- (Doc -> Identifier)
-> Mon (State SystemVerilogState) Doc -> SystemVerilogM Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
Text.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 0))
  HWType -> Identifier -> Mon (State SystemVerilogState) Doc
simpleFromSLV HWType
elTy Identifier
id'

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((RTree n :: Int
n _),1,0)))) =
  let z :: Int
z = 2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
  in  Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 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
-1))

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((RTree n :: Int
n _),1,1)))) =
  let z :: Int
z  = 2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
      z' :: Int
z' = 2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n
  in Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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
-1))

-- This is a HACK for Clash.Driver.TopWrapper.mkOutput
-- Vector's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Vector _ elTy :: HWType
elTy),10,fI :: Int
fI)))) = do
  Identifier
id' <- (Doc -> Identifier)
-> Mon (State SystemVerilogState) Doc -> SystemVerilogM Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
Text.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 -> Identifier -> Mon (State SystemVerilogState) Doc
simpleFromSLV HWType
elTy Identifier
id'

-- This is a HACK for Clash.Driver.TopWrapper.mkOutput
-- RTree's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((RTree _ elTy :: HWType
elTy),10,fI :: Int
fI)))) = do
  Identifier
id' <- (Doc -> Identifier)
-> Mon (State SystemVerilogState) Doc -> SystemVerilogM Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
Text.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 -> Identifier -> Mon (State SystemVerilogState) Doc
simpleFromSLV HWType
elTy Identifier
id'

expr_ _ (Identifier id_ :: Identifier
id_ (Just (DC (ty :: HWType
ty@(SP _ _),_)))) = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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
- 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_ _ (Identifier id_ :: Identifier
id_ (Just m :: Modifier
m@Nested {})) = case Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier 0 [] Modifier
m of
  Nothing -> Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
id_
  Just (mods :: [Either NMod NMod]
mods,resTy :: HWType
resTy) -> do
    Identifier
nm <- State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Identifier -> SystemVerilogM Identifier)
-> State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier SystemVerilogState Identifier
-> State SystemVerilogState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier SystemVerilogState Identifier
Lens' SystemVerilogState Identifier
modNm
    Bool
pkgCtx <- StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (StateT SystemVerilogState Identity Bool
 -> Mon (State SystemVerilogState) Bool)
-> StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> StateT SystemVerilogState Identity 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 Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
nm Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "_types::"
    let e :: Mon (State SystemVerilogState) Doc
e = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 _ -> "$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]
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
<> "_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]
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
<> "_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
      _ -> Mon (State SystemVerilogState) Doc
e
 where
  bracketNMod :: NMod -> f Doc
bracketNMod (NElem i :: 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 s :: Int
s e :: 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_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Signed w :: Int
w),_,_))))  = 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) ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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). Applicative f => Identifier -> f Doc
stringS Identifier
id_

-- See [Note] integer projection
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Unsigned w :: Int
w),_,_))))  = 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) ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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). Applicative f => Identifier -> f Doc
stringS Identifier
id_

-- See [Note] mask projection
expr_ _ (Identifier _ (Just (Indexed ((BitVector _),_,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 ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((BitVector w :: Int
w),_,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) ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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). Applicative f => Identifier -> f Doc
stringS Identifier
id_

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Sliced ((BitVector _,start :: Int
start,end :: Int
end))))) =
  Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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
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_ _ (Identifier id_ :: Identifier
id_ (Just _)) = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
id_

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

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

expr_ _ (DataCon (Vector 1 elTy :: HWType
elTy) _ [e :: 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
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV HWType
elTy Expr
e)

expr_ _ e :: Expr
e@(DataCon ty :: HWType
ty@(Vector _ elTy :: HWType
elTy) _ [e1 :: Expr
e1,e2 :: Expr
e2]) = case Expr -> Maybe [Expr]
vectorChain Expr
e of
  Just es :: [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]
-> 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)
  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
<> "_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_ _ (DataCon (RTree 0 elTy :: HWType
elTy) _ [e :: 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
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV HWType
elTy Expr
e)

expr_ _ e :: Expr
e@(DataCon ty :: HWType
ty@(RTree _ elTy :: HWType
elTy) _ [e1 :: Expr
e1,e2 :: Expr
e2]) = case Expr -> Maybe [Expr]
rtreeChain Expr
e of
  Just es :: [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]
-> 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)
  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
<> "_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_ _ (DataCon (SP {}) (DC (BitVector _,_)) es :: [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_ _ (DataCon ty :: HWType
ty@(SP _ args :: [(Identifier, [HWType])]
args) (DC (_,i :: Int
i)) es :: [Expr]
es) = Mon (State SystemVerilogState) Doc
assignExpr
  where
    argTys :: [HWType]
argTys     = (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Identifier, [HWType]) -> [HWType])
-> (Identifier, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Identifier, [HWType])]
args [(Identifier, [HWType])] -> Int -> (Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
i
    dcSize :: Int
dcSize     = HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ((HWType -> Int) -> [HWType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Int
typeSize [HWType]
argTys)
    dcExpr :: Mon (State 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
                   0 -> []
                   n :: 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
<> "'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_ _ (DataCon ty :: HWType
ty@(Sum _ _) (DC (_,i :: 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
<> "'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_ _ (DataCon ty :: HWType
ty@(CustomSum _ _ _ tys :: [(ConstrRepr', Identifier)]
tys) (DC (_,i :: Int
i)) []) =
  let (ConstrRepr' _ _ _ value :: Integer
value _) = (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Identifier) -> ConstrRepr')
-> (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Identifier)]
tys [(ConstrRepr', Identifier)] -> Int -> (ConstrRepr', Identifier)
forall a. [a] -> Int -> a
!! Int
i in
  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
<> "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_ _ (DataCon (CustomSP _ dataRepr :: DataRepr'
dataRepr _size :: Int
_size args :: [(ConstrRepr', Identifier, [HWType])]
args) (DC (_,i :: Int
i)) es :: [Expr]
es) =
  let (cRepr :: ConstrRepr'
cRepr, _, argTys :: [HWType]
argTys) = [(ConstrRepr', Identifier, [HWType])]
args [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
i in
  DataRepr'
-> ConstrRepr'
-> [(HWType, Expr)]
-> Mon (State SystemVerilogState) Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HWType]
argTys [Expr]
es)
expr_ _ (DataCon (CustomProduct _ dataRepr :: DataRepr'
dataRepr _size :: Int
_size _labels :: Maybe [Identifier]
_labels tys :: [(Integer, HWType)]
tys) _ es :: [Expr]
es) |
  DataRepr' _typ :: Type'
_typ _size :: Int
_size [cRepr :: ConstrRepr'
cRepr] <- DataRepr'
dataRepr =
  DataRepr'
-> ConstrRepr'
-> [(HWType, Expr)]
-> Mon (State SystemVerilogState) Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((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_ _ (DataCon (Product _ _ tys :: [HWType]
tys) _ es :: [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_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Signed.fromInteger#"
  , [Literal _ (NumLit n :: Integer
n), Literal _ i :: 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_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Unsigned.fromInteger#"
  , [Literal _ (NumLit n :: Integer
n), Literal _ i :: 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_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger#"
  , [Literal _ (NumLit n :: Integer
n), Literal _ (NumLit m :: Integer
m), Literal _ (NumLit i :: 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_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger##"
  , [Literal _ m :: Literal
m, Literal _ i :: Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = let NumLit m' :: Integer
m' = Literal
m
        NumLit i' :: 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,1)) (Bit -> Literal
BitLit (Bit -> Literal) -> Bit -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Bit
toBit Integer
m' Integer
i')

expr_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Index.fromInteger#"
  , [Literal _ (NumLit n :: Integer
n), Literal _ i :: 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_ b :: Bool
b (BlackBoxE _ libs :: [BlackBoxTemplate]
libs imps :: [BlackBoxTemplate]
imps inc :: [((Identifier, Identifier), BlackBox)]
inc bs :: BlackBox
bs bbCtx :: BlackBoxContext
bbCtx b' :: 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]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT SystemVerilogState Identity (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx StateT 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 0))

expr_ _ (DataTag Bool (Left id_ :: Identifier
id_))          = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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 0)
expr_ _ (DataTag Bool (Right id_ :: 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
  "$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
-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 "1'b0"),Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
id_]))

expr_ _ (DataTag (Sum _ _) (Left id_ :: Identifier
id_))     = "$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). Applicative f => Identifier -> f Doc
stringS Identifier
id_)
expr_ _ (DataTag (Sum _ _) (Right id_ :: Identifier
id_))    = "$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). Applicative f => Identifier -> f Doc
stringS Identifier
id_)

expr_ _ (DataTag (Product {}) (Right _))  = 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
<> "'sd0"

expr_ _ (DataTag hty :: HWType
hty@(SP _ _) (Right id_ :: Identifier
id_)) = "$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). Applicative f => Identifier -> f Doc
stringS 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
- 1
    end :: Int
end   = HWType -> Int
typeSize HWType
hty Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
hty

expr_ _ (DataTag (Vector 0 _) (Right _)) = do
  Int
iw <- State 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
<> "'sd0"
expr_ _ (DataTag (Vector _ _) (Right _)) = 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
<> "'sd1"

expr_ _ (DataTag (RTree 0 _) (Right _)) = 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
<> "'sd0"
expr_ _ (DataTag (RTree _ _) (Right _)) = 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
<> "'sd1"

expr_ b :: Bool
b (ConvBV topM :: Maybe Identifier
topM t :: HWType
t True e :: Expr
e) = do
  Identifier
nm <- State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Identifier -> SystemVerilogM Identifier)
-> State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier SystemVerilogState Identifier
-> State SystemVerilogState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier SystemVerilogState Identifier
Lens' SystemVerilogState Identifier
modNm
  Bool
pkgCtx <- StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (StateT SystemVerilogState Identity Bool
 -> Mon (State SystemVerilogState) Bool)
-> StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> StateT SystemVerilogState Identity 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 Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
nm Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "_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
<> "_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). Applicative f => Identifier -> f Doc
stringS) 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
<> "_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
<> "_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). Applicative f => Identifier -> f Doc
stringS) 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
<> "_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)
    _ -> Bool -> Expr -> Mon (State SystemVerilogState) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
b Expr
e

expr_ b :: Bool
b (ConvBV topM :: Maybe Identifier
topM t :: HWType
t False e :: Expr
e) = do
  Identifier
nm <- State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State SystemVerilogState Identifier -> SystemVerilogM Identifier)
-> State SystemVerilogState Identifier -> SystemVerilogM Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier SystemVerilogState Identifier
-> State SystemVerilogState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier SystemVerilogState Identifier
Lens' SystemVerilogState Identifier
modNm
  Bool
pkgCtx <- StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (StateT SystemVerilogState Identity Bool
 -> Mon (State SystemVerilogState) Bool)
-> StateT SystemVerilogState Identity Bool
-> Mon (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> StateT SystemVerilogState Identity 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 Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
nm Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "_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
<> "_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). Applicative f => Identifier -> f Doc
stringS) 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
<> "_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
<> "_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). Applicative f => Identifier -> f Doc
stringS) 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
<> "_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)
    _ -> Bool -> Expr -> Mon (State SystemVerilogState) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
b Expr
e

expr_ b :: Bool
b (IfThenElse c :: Expr
c t :: Expr
t e :: 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
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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
True Expr
e)

expr_ _ e :: 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
$ $(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 _ n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = 0
otherSize []     _    = 0
otherSize (a :: HWType
a:as :: [HWType]
as) n :: Int
n    = HWType -> Int
typeSize HWType
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [HWType] -> Int -> Int
otherSize [HWType]
as (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)

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

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

toSLV :: HWType -> Expr -> SystemVerilogM Doc
toSLV :: HWType -> Expr -> Mon (State SystemVerilogState) Doc
toSLV t :: HWType
t e :: Expr
e = case HWType
t of
  Vector _ _ -> 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
<> "_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 _ _ -> 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
<> "_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))
  _ -> Bool -> Expr -> Mon (State SystemVerilogState) Doc
expr_ Bool
False Expr
e

fromSLV :: HWType -> Identifier -> Int -> Int -> SystemVerilogM Doc
fromSLV :: HWType
-> Identifier -> Int -> Int -> Mon (State SystemVerilogState) Doc
fromSLV t :: HWType
t@(Vector _ _) id_ :: Identifier
id_ start :: Int
start end :: 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
<> "_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 (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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))
fromSLV t :: HWType
t@(RTree _ _) id_ :: Identifier
id_ start :: Int
start end :: 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
<> "_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 (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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))
fromSLV (Signed _) id_ :: Identifier
id_ start :: Int
start end :: Int
end = "$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 (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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))
fromSLV _ id_ :: Identifier
id_ start :: Int
start end :: Int
end = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS 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)

simpleFromSLV :: HWType -> Identifier -> SystemVerilogM Doc
simpleFromSLV :: HWType -> Identifier -> Mon (State SystemVerilogState) Doc
simpleFromSLV t :: HWType
t@(Vector _ _) id_ :: Identifier
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
<> "_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 (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
id_)
simpleFromSLV t :: HWType
t@(RTree _ _) id_ :: Identifier
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
<> "_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 (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
id_)
simpleFromSLV (Signed _) id_ :: Identifier
id_ = "$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 (Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
id_)
simpleFromSLV _ id_ :: Identifier
id_ = Identifier -> Mon (State SystemVerilogState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
id_

expFromSLV :: HWType -> SystemVerilogM Doc -> SystemVerilogM Doc
expFromSLV :: HWType
-> Mon (State SystemVerilogState) Doc
-> Mon (State SystemVerilogState) Doc
expFromSLV t :: HWType
t@(Vector _ _) exp_ :: 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
<> "_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 _ _) exp_ :: 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
<> "_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 _) exp_ :: Mon (State SystemVerilogState) Doc
exp_ = "$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 _ exp_ :: Mon (State SystemVerilogState) Doc
exp_ = Mon (State SystemVerilogState) Doc
exp_

dcToExpr :: HWType -> Int -> Expr
dcToExpr :: HWType -> Int -> Expr
dcToExpr ty :: HWType
ty i :: Int
i = Maybe (HWType, Int) -> Literal -> Expr
Literal ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
ty,HWType -> Int
conSize HWType
ty)) (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 True  = m Doc -> m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens
parenIf 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' s :: Mon m Doc
s d :: Mon m [Doc]
d = Mon m [Doc] -> Mon m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon m Doc -> Mon m [Doc] -> Mon m [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon m Doc
s Mon m [Doc]
d) Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
s


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 offset :: Int
offset mods :: [Either NMod NMod]
mods (Sliced (BitVector _,start :: Int
start,end :: 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 {}:rest :: [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
+1))
    _ -> ([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
+1))

modifier offset :: Int
offset mods :: [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(SP _ args :: [(Identifier, [HWType])]
args),dcI :: Int
dcI,fI :: Int
fI)) =
  ([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]
mods, HWType
argTy)
  where
    argTys :: [HWType]
argTys   = (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Identifier, [HWType]) -> [HWType])
-> (Identifier, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Identifier, [HWType])]
args [(Identifier, [HWType])] -> Int -> (Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI
    argTy :: HWType
argTy    = [HWType]
argTys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI
    argSize :: Int
argSize  = HWType -> Int
typeSize HWType
argTy
    other :: Int
other    = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
    start :: Int
start    = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
other
    end :: Int
end      = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1

modifier offset :: Int
offset mods :: [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(Product _ _ argTys :: [HWType]
argTys),_,fI :: 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 {}:rest :: [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], 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
- 1)
    start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
+ 1

modifier offset :: Int
offset mods :: [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(Vector _ argTy :: HWType
argTy),1,0)) = case [Either NMod NMod]
mods of
    Right {}:rest :: [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 b :: Int
b _):rest :: [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], 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 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
- 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
+ 1

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

modifier offset :: Int
offset mods :: [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(RTree 0 argTy :: HWType
argTy),0,0)) = case [Either NMod NMod]
mods of
    Right {}:rest :: [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 b :: Int
b _):rest :: [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], 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 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
- 1

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

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

-- This is a HACK for Clash.Driver.TopWrapper.mkOutput
-- Vector's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
modifier offset :: Int
offset mods :: [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(Vector _ argTy :: HWType
argTy),10,fI :: Int
fI)) = case [Either NMod NMod]
mods of
    Right {}:rest :: [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 b :: Int
b _):rest :: [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], 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
- 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
+ 1

-- This is a HACK for Clash.Driver.TopWrapper.mkOutput
-- RTree's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
modifier offset :: Int
offset mods :: [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(RTree _ argTy :: HWType
argTy),10,fI :: Int
fI)) = case [Either NMod NMod]
mods of
    Right {}:rest :: [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 b :: Int
b _):rest :: [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], 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
- 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
+ 1

modifier offset :: Int
offset mods :: [Either NMod NMod]
mods (Indexed (CustomSP typName :: Identifier
typName _dataRepr :: DataRepr'
_dataRepr _size :: Int
_size args :: [(ConstrRepr', Identifier, [HWType])]
args,dcI :: Int
dcI,fI :: Int
fI)) =
  case Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. [a] -> Int -> a
!! Int
fI) of
    [(start :: Int
start,end :: 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 {}:rest :: [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], 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)
    _ ->
      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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Cannot handle projection out of a "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "non-contiguously or zero-width encoded field. Tried to project "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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]
++ " 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]
++ " of "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "data type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
typName String -> String -> String
forall a. [a] -> [a] -> [a]
++  "."
 where
  (ConstrRepr' _name :: Identifier
_name _n :: Int
_n _mask :: Integer
_mask _value :: Integer
_value anns :: [Integer]
anns, _, argTys :: [HWType]
argTys) = [(ConstrRepr', Identifier, [HWType])]
args [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI
  argTy :: HWType
argTy = [HWType]
argTys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI

modifier offset :: Int
offset mods :: [Either NMod NMod]
mods (Indexed (CustomProduct typName :: Identifier
typName dataRepr :: DataRepr'
dataRepr _size :: Int
_size _maybeFieldNames :: Maybe [Identifier]
_maybeFieldNames args :: [(Integer, HWType)]
args,dcI :: Int
dcI,fI :: Int
fI))
  | DataRepr' _typ :: Type'
_typ _size :: Int
_size [cRepr :: ConstrRepr'
cRepr] <- DataRepr'
dataRepr
  , ConstrRepr' _cName :: Identifier
_cName _pos :: Int
_pos _mask :: Integer
_mask _val :: Integer
_val fieldAnns :: [Integer]
fieldAnns <- ConstrRepr'
cRepr =
  case Integer -> [(Int, Int)]
bitRanges ([Integer]
fieldAnns [Integer] -> Int -> Integer
forall a. [a] -> Int -> a
!! Int
fI) of
    [(start :: Int
start,end :: 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 {}:rest :: [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], 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)
    _ ->
      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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Cannot handle projection out of a "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "non-contiguously or zero-width encoded field. Tried to project "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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]
++ " 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]
++ " of "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "data type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
typName String -> String -> String
forall a. [a] -> [a] -> [a]
++ "."
 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 offset :: Int
offset mods :: [Either NMod NMod]
mods (DC (ty :: HWType
ty@(SP _ _),_)) =
    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 {}:rest :: [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], 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
- 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 offset :: Int
offset mods :: [Either NMod NMod]
mods (Nested m1 :: Modifier
m1 m2 :: Modifier
m2) = do
  case Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier Int
offset [Either NMod NMod]
mods Modifier
m1 of
    Nothing -> Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier Int
offset [Either NMod NMod]
mods Modifier
m2
    Just (mods1 :: [Either NMod NMod]
mods1,argTy :: HWType
argTy) ->
      let m3 :: Maybe ([Either NMod NMod], HWType)
m3 = case [Either NMod NMod]
mods1 of
                 Right (NRange _ e :: Int
e):_ -> Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier Int
e [Either NMod NMod]
mods1 Modifier
m2
                 _ -> Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier 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
        Nothing -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just ([Either NMod NMod]
mods1,HWType
argTy)
        m :: Maybe ([Either NMod NMod], HWType)
m       -> Maybe ([Either NMod NMod], HWType)
m

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