{-|
  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 Verilog for assorted Netlist datatypes
-}

{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE RecursiveDo       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}

module Clash.Backend.Verilog
  ( VerilogState
  , include
  , uselibs
  , encodingNote
  , exprLit
  , bits
  , bit_char
  )
where

import qualified Control.Applicative                  as A
import           Control.Lens                         (Lens',(+=),(-=),(.=),(%=), makeLenses, use)
import           Control.Monad                        (forM)
import           Control.Monad.State                  (State)
import           Data.Bits                            (Bits, testBit)
import           Data.HashMap.Strict                  (HashMap)
import qualified Data.HashMap.Strict                  as HashMap
import qualified Data.HashSet                         as HashSet
import           Data.Maybe                           (catMaybes,fromMaybe,mapMaybe)
import           Data.List                            (nub, nubBy)
#if !MIN_VERSION_base(4,11,0)
import           Data.Monoid                          hiding (Product, Sum)
#endif
import           Data.Semigroup.Monad
import           Data.Text.Lazy                       (pack)
import qualified Data.Text.Lazy                       as Text
import qualified Data.Text                            as TextS
import           Data.Text.Prettyprint.Doc.Extra
#ifdef CABAL
import qualified Data.Version
#endif
import qualified System.FilePath

import           Clash.Annotations.Primitive          (HDL (..))
import           Clash.Annotations.BitRepresentation  (BitMask)
import           Clash.Annotations.BitRepresentation.ClashLib
  (bitsToBits)
import           Clash.Annotations.BitRepresentation.Internal
  (ConstrRepr'(..))
import           Clash.Annotations.BitRepresentation.Util
  (BitOrigin(Lit, Field), bitOrigins, bitRanges, isContinuousMask)
import           Clash.Core.Var                       (Attr'(..))
import           Clash.Backend
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.Util
  (SrcSpan, noSrcSpan, curLoc, traceIf, (<:>),on,first)




#ifdef CABAL
import qualified Paths_clash_lib
#endif

-- | State for the 'Clash.Backend.Verilog.VerilogM' monad:
data VerilogState =
  VerilogState
    { VerilogState -> Int
_genDepth  :: Int -- ^ Depth of current generative block
    , VerilogState -> HashMap Identifier Word
_idSeen    :: HashMap Identifier Word
    , VerilogState -> SrcSpan
_srcSpan   :: SrcSpan
    , VerilogState -> [(String, Doc)]
_includes  :: [(String,Doc)]
    , VerilogState -> [Text]
_imports   :: [Text.Text]
    , VerilogState -> [Text]
_libraries :: [Text.Text]
    , VerilogState -> [(String, String)]
_dataFiles      :: [(String,FilePath)]
    -- ^ Files to be copied: (filename, old path)
    , VerilogState -> [(String, String)]
_memoryDataFiles:: [(String,String)]
    -- ^ Files to be stored: (filename, contents). These files are generated
    -- during the execution of 'genNetlist'.
    , VerilogState -> Int
_intWidth  :: Int -- ^ Int/Word/Integer bit-width
    , VerilogState -> HdlSyn
_hdlsyn    :: HdlSyn
    , VerilogState -> Bool
_escapedIds :: Bool
    , VerilogState -> Maybe (Maybe Int)
_undefValue :: Maybe (Maybe Int)
    }

makeLenses ''VerilogState

squote :: Mon (State VerilogState) Doc
squote :: Mon (State VerilogState) Doc
squote = Text -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "'"

primsRoot :: IO FilePath
#ifdef CABAL
primsRoot :: IO String
primsRoot = String -> IO String
Paths_clash_lib.getDataFileName "prims"
#else
primsRoot = return ("clash-lib" System.FilePath.</> "prims")
#endif

instance Backend VerilogState where
  initBackend :: Int -> HdlSyn -> Bool -> Maybe (Maybe Int) -> VerilogState
initBackend     = Int
-> HashMap Identifier Word
-> SrcSpan
-> [(String, Doc)]
-> [Text]
-> [Text]
-> [(String, String)]
-> [(String, String)]
-> Int
-> HdlSyn
-> Bool
-> Maybe (Maybe Int)
-> VerilogState
VerilogState 0 HashMap Identifier Word
forall k v. HashMap k v
HashMap.empty SrcSpan
noSrcSpan [] [] [] [] []
  hdlKind :: VerilogState -> HDL
hdlKind         = HDL -> VerilogState -> HDL
forall a b. a -> b -> a
const HDL
Verilog
  primDirs :: VerilogState -> IO [String]
primDirs        = IO [String] -> VerilogState -> IO [String]
forall a b. a -> b -> a
const (IO [String] -> VerilogState -> IO [String])
-> IO [String] -> VerilogState -> IO [String]
forall a b. (a -> b) -> a -> b
$ do String
root <- IO String
primsRoot
                               [String] -> IO [String]
forall (m :: * -> *) 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.</> "verilog"
                                      ]
  extractTypes :: VerilogState -> HashSet HWType
extractTypes    = HashSet HWType -> VerilogState -> HashSet HWType
forall a b. a -> b -> a
const HashSet HWType
forall a. HashSet a
HashSet.empty
  name :: VerilogState -> String
name            = String -> VerilogState -> String
forall a b. a -> b -> a
const "verilog"
  extension :: VerilogState -> String
extension       = String -> VerilogState -> String
forall a b. a -> b -> a
const ".v"

  genHDL :: Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VerilogState) ((String, Doc), [(String, Doc)])
genHDL          = (SrcSpan
 -> HashMap Identifier Word
 -> Component
 -> Mon (State VerilogState) ((String, Doc), [(String, Doc)]))
-> Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VerilogState) ((String, Doc), [(String, Doc)])
forall a b. a -> b -> a
const SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VerilogState) ((String, Doc), [(String, Doc)])
genVerilog
  mkTyPackage :: Identifier -> [HWType] -> Mon (State VerilogState) [(String, Doc)]
mkTyPackage _ _ = [(String, Doc)] -> Mon (State VerilogState) [(String, Doc)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  hdlType :: Usage -> HWType -> Mon (State VerilogState) Doc
hdlType _       = HWType -> Mon (State VerilogState) Doc
verilogType
  hdlTypeErrValue :: HWType -> Mon (State VerilogState) Doc
hdlTypeErrValue = HWType -> Mon (State VerilogState) Doc
verilogTypeErrValue
  hdlTypeMark :: HWType -> Mon (State VerilogState) Doc
hdlTypeMark     = HWType -> Mon (State VerilogState) Doc
verilogTypeMark
  hdlRecSel :: HWType -> Int -> Mon (State VerilogState) Doc
hdlRecSel       = HWType -> Int -> Mon (State VerilogState) Doc
verilogRecSel
  hdlSig :: Text -> HWType -> Mon (State VerilogState) Doc
hdlSig t :: Text
t ty :: HWType
ty     = Mon (State VerilogState) Doc
-> HWType -> Mon (State VerilogState) Doc
sigDecl (Text -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string Text
t) HWType
ty
  genStmt :: Bool -> State VerilogState Doc
genStmt True    = do Int
cnt <- Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
genDepth
                       (Int -> Identity Int) -> VerilogState -> Identity VerilogState
Lens' VerilogState Int
genDepth ((Int -> Identity Int) -> VerilogState -> Identity VerilogState)
-> Int -> State VerilogState ()
forall s (m :: * -> *) 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 VerilogState Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc
                          else "generate"
  genStmt False   = do (Int -> Identity Int) -> VerilogState -> Identity VerilogState
Lens' VerilogState Int
genDepth ((Int -> Identity Int) -> VerilogState -> Identity VerilogState)
-> Int -> State VerilogState ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= 1
                       Int
cnt <- Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
genDepth
                       if Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                          then State VerilogState Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc
                          else "endgenerate"
  inst :: Declaration -> Mon (State VerilogState) (Maybe Doc)
inst            = Declaration -> Mon (State VerilogState) (Maybe Doc)
inst_
  expr :: Bool -> Expr -> Mon (State VerilogState) Doc
expr            = Bool -> Expr -> Mon (State VerilogState) Doc
expr_
  iwWidth :: State VerilogState Int
iwWidth         = Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  toBV :: HWType -> Text -> Mon (State VerilogState) Doc
toBV _          = Text -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string
  fromBV :: HWType -> Text -> Mon (State VerilogState) Doc
fromBV _        = Text -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string
  hdlSyn :: State VerilogState HdlSyn
hdlSyn          = Getting HdlSyn VerilogState HdlSyn -> State VerilogState HdlSyn
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting HdlSyn VerilogState HdlSyn
Lens' VerilogState HdlSyn
hdlsyn
  mkIdentifier :: State VerilogState (IdType -> Identifier -> Identifier)
mkIdentifier    = do
      Bool
allowEscaped <- Getting Bool VerilogState Bool -> StateT VerilogState Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool VerilogState Bool
Lens' VerilogState Bool
escapedIds
      (IdType -> Identifier -> Identifier)
-> State VerilogState (IdType -> Identifier -> Identifier)
forall (m :: * -> *) 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
Verilog Bool
True Identifier
nm) of
        nm' :: Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> "_clash_internal"
            | Bool
otherwise      -> Identifier
nm'
      go esc :: Bool
esc Extended (Identifier -> Identifier
rmSlash -> Identifier
nm) = case Bool -> IdType -> Identifier -> Identifier
go Bool
esc IdType
Basic Identifier
nm of
        nm' :: Identifier
nm' | Bool
esc Bool -> Bool -> Bool
&& Identifier
nm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
nm' -> [Identifier] -> Identifier
TextS.concat ["\\",Identifier
nm," "]
            | Bool
otherwise -> Identifier
nm'
  extendIdentifier :: State
  VerilogState (IdType -> Identifier -> Identifier -> Identifier)
extendIdentifier = do
      Bool
allowEscaped <- Getting Bool VerilogState Bool -> StateT VerilogState Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool VerilogState Bool
Lens' VerilogState Bool
escapedIds
      (IdType -> Identifier -> Identifier -> Identifier)
-> State
     VerilogState (IdType -> Identifier -> Identifier -> Identifier)
forall (m :: * -> *) 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
Verilog Bool
True (Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
ext)) of
          nm' :: Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> "_clash_internal"
              | Bool
otherwise      -> Identifier
nm'
      go esc :: Bool
esc Extended (Identifier -> Identifier
rmSlash (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
escapeTemplate -> Identifier
nm) ext :: Identifier
ext =
        let nmExt :: Identifier
nmExt = Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
ext
        in  case Bool -> IdType -> Identifier -> Identifier -> Identifier
go Bool
esc IdType
Basic Identifier
nm Identifier
ext of
              nm' :: Identifier
nm' | Bool
esc Bool -> Bool -> Bool
&& Identifier
nm' Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
nmExt -> case Identifier -> Identifier -> Bool
TextS.isPrefixOf "c$" Identifier
nmExt of
                      True -> [Identifier] -> Identifier
TextS.concat ["\\",Identifier
nmExt," "]
                      _    -> [Identifier] -> Identifier
TextS.concat ["\\c$",Identifier
nmExt," "]
                  | Bool
otherwise -> Identifier
nm'

  setModName :: Identifier -> VerilogState -> VerilogState
setModName _    = VerilogState -> VerilogState
forall a. a -> a
id
  setSrcSpan :: SrcSpan -> State VerilogState ()
setSrcSpan      = ((SrcSpan -> Identity SrcSpan)
-> VerilogState -> Identity VerilogState
Lens' VerilogState SrcSpan
srcSpan ((SrcSpan -> Identity SrcSpan)
 -> VerilogState -> Identity VerilogState)
-> SrcSpan -> State VerilogState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)
  getSrcSpan :: State VerilogState SrcSpan
getSrcSpan      = Getting SrcSpan VerilogState SrcSpan -> State VerilogState SrcSpan
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting SrcSpan VerilogState SrcSpan
Lens' VerilogState SrcSpan
srcSpan
  blockDecl :: Identifier -> [Declaration] -> Mon (State VerilogState) Doc
blockDecl _ ds :: [Declaration]
ds  = do
    Doc
decs <- [Declaration] -> Mon (State VerilogState) Doc
decls [Declaration]
ds
    if Doc -> Bool
isEmpty Doc
decs
      then Int -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
indent 2 ([Declaration] -> Mon (State VerilogState) Doc
insts [Declaration]
ds)
      else
        Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
decs Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
        Int -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
indent 2 ([Declaration] -> Mon (State VerilogState) Doc
insts [Declaration]
ds)
  unextend :: State VerilogState (Identifier -> Identifier)
unextend = (Identifier -> Identifier)
-> State VerilogState (Identifier -> Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return Identifier -> Identifier
rmSlash
  addIncludes :: [(String, Doc)] -> State VerilogState ()
addIncludes inc :: [(String, Doc)]
inc = ([(String, Doc)] -> Identity [(String, Doc)])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [(String, Doc)]
includes (([(String, Doc)] -> Identity [(String, Doc)])
 -> VerilogState -> Identity VerilogState)
-> ([(String, Doc)] -> [(String, Doc)]) -> State VerilogState ()
forall s (m :: * -> *) 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 VerilogState ()
addLibraries libs :: [Text]
libs = ([Text] -> Identity [Text])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [Text]
libraries (([Text] -> Identity [Text])
 -> VerilogState -> Identity VerilogState)
-> ([Text] -> [Text]) -> State VerilogState ()
forall s (m :: * -> *) 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 VerilogState ()
addImports inps :: [Text]
inps = ([Text] -> Identity [Text])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [Text]
imports (([Text] -> Identity [Text])
 -> VerilogState -> Identity VerilogState)
-> ([Text] -> [Text]) -> State VerilogState ()
forall s (m :: * -> *) 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 VerilogState String
addAndSetData f :: String
f = do
    [(String, String)]
fs <- Getting [(String, String)] VerilogState [(String, String)]
-> State VerilogState [(String, String)]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [(String, String)] VerilogState [(String, String)]
Lens' VerilogState [(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)])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [(String, String)]
dataFiles (([(String, String)] -> Identity [(String, String)])
 -> VerilogState -> Identity VerilogState)
-> [(String, String)] -> State VerilogState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(String, String)]
fs'
    String -> State VerilogState String
forall (m :: * -> *) a. Monad m => a -> m a
return String
f'
  getDataFiles :: State VerilogState [(String, String)]
getDataFiles = Getting [(String, String)] VerilogState [(String, String)]
-> State VerilogState [(String, String)]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [(String, String)] VerilogState [(String, String)]
Lens' VerilogState [(String, String)]
dataFiles
  addMemoryDataFile :: (String, String) -> State VerilogState ()
addMemoryDataFile f :: (String, String)
f = ([(String, String)] -> Identity [(String, String)])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [(String, String)]
memoryDataFiles (([(String, String)] -> Identity [(String, String)])
 -> VerilogState -> Identity VerilogState)
-> ([(String, String)] -> [(String, String)])
-> State VerilogState ()
forall s (m :: * -> *) 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 VerilogState [(String, String)]
getMemoryDataFiles = Getting [(String, String)] VerilogState [(String, String)]
-> State VerilogState [(String, String)]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [(String, String)] VerilogState [(String, String)]
Lens' VerilogState [(String, String)]
memoryDataFiles
  seenIdentifiers :: (HashMap Identifier Word -> f (HashMap Identifier Word))
-> VerilogState -> f VerilogState
seenIdentifiers = (HashMap Identifier Word -> f (HashMap Identifier Word))
-> VerilogState -> f VerilogState
Lens' VerilogState (HashMap Identifier Word)
idSeen
  ifThenElseExpr :: VerilogState -> 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 :: * -> *) 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 VerilogM a = Mon (State VerilogState) a

-- List of reserved Verilog-2005 keywords
reservedWords :: [Identifier]
reservedWords :: [Identifier]
reservedWords = ["always","and","assign","automatic","begin","buf","bufif0"
  ,"bufif1","case","casex","casez","cell","cmos","config","deassign","default"
  ,"defparam","design","disable","edge","else","end","endcase","endconfig"
  ,"endfunction","endgenerate","endmodule","endprimitive","endspecify"
  ,"endtable","endtask","event","for","force","forever","fork","function"
  ,"generate","genvar","highz0","highz1","if","ifnone","incdir","include"
  ,"initial","inout","input","instance","integer","join","large","liblist"
  ,"library","localparam","macromodule","medium","module","nand","negedge"
  ,"nmos","nor","noshowcancelled","not","notif0","notif1","or","output"
  ,"parameter","pmos","posedge","primitive","pull0","pull1","pulldown","pullup"
  ,"pulsestyle_onevent","pulsestyle_ondetect","rcmos","real","realtime","reg"
  ,"release","repeat","rnmos","rpmos","rtran","rtranif0","rtranif1","scalared"
  ,"showcancelled","signed","small","specify","specparam","strong0","strong1"
  ,"supply0","supply1","table","task","time","tran","tranif0","tranif1","tri"
  ,"tri0","tri1","triand","trior","trireg","unsigned","use","uwire","vectored"
  ,"wait","wand","weak0","weak1","while","wire","wor","xnor","xor"]

filterReserved :: Identifier -> Identifier
filterReserved :: Identifier -> Identifier
filterReserved s :: Identifier
s = if Identifier
s Identifier -> [Identifier] -> Bool
forall (t :: * -> *) 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 VHDL for a Netlist component
genVerilog :: SrcSpan -> HashMap Identifier Word -> Component -> VerilogM ((String,Doc),[(String,Doc)])
genVerilog :: SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VerilogState) ((String, Doc), [(String, Doc)])
genVerilog sp :: SrcSpan
sp seen :: HashMap Identifier Word
seen c :: Component
c = Mon (State VerilogState) ((String, Doc), [(String, Doc)])
-> Mon (State VerilogState) ((String, Doc), [(String, Doc)])
forall s a. Backend s => Mon (State s) a -> Mon (State s) a
preserveSeen (Mon (State VerilogState) ((String, Doc), [(String, Doc)])
 -> Mon (State VerilogState) ((String, Doc), [(String, Doc)]))
-> Mon (State VerilogState) ((String, Doc), [(String, Doc)])
-> Mon (State VerilogState) ((String, Doc), [(String, Doc)])
forall a b. (a -> b) -> a -> b
$ do
    State VerilogState () -> Mon (State VerilogState) ()
forall (f :: * -> *) m. f m -> Mon f m
Mon ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VerilogState -> Identity VerilogState
Lens' VerilogState (HashMap Identifier Word)
idSeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> VerilogState -> Identity VerilogState)
-> HashMap Identifier Word -> State VerilogState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= HashMap Identifier Word
seen)
    State VerilogState () -> Mon (State VerilogState) ()
forall (f :: * -> *) m. f m -> Mon f m
Mon (SrcSpan -> State VerilogState ()
forall state. Backend state => SrcSpan -> State state ()
setSrcSpan SrcSpan
sp)
    Doc
v    <- Mon (State VerilogState) Doc
commentHeader Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
timescale Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Component -> Mon (State VerilogState) Doc
module_ Component
c
    [(String, Doc)]
incs <- State VerilogState [(String, Doc)]
-> Mon (State VerilogState) [(String, Doc)]
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState [(String, Doc)]
 -> Mon (State VerilogState) [(String, Doc)])
-> State VerilogState [(String, Doc)]
-> Mon (State VerilogState) [(String, Doc)]
forall a b. (a -> b) -> a -> b
$ Getting [(String, Doc)] VerilogState [(String, Doc)]
-> State VerilogState [(String, Doc)]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [(String, Doc)] VerilogState [(String, Doc)]
Lens' VerilogState [(String, Doc)]
includes
    ((String, Doc), [(String, Doc)])
-> Mon (State VerilogState) ((String, Doc), [(String, Doc)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Identifier -> String
TextS.unpack Identifier
cName,Doc
v),[(String, Doc)]
incs)
  where
#ifdef CABAL
    clashVer :: String
clashVer = Version -> String
Data.Version.showVersion Version
Paths_clash_lib.version
#else
    clashVer = "development"
#endif
    cName :: Identifier
cName    = Component -> Identifier
componentName Component
c
    commentHeader :: Mon (State VerilogState) Doc
commentHeader
         = "/* AUTOMATICALLY GENERATED VERILOG-2001 SOURCE CODE."
      Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "** GENERATED BY CLASH " Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string (String -> Text
Text.pack String
clashVer) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> ". DO NOT MODIFY."
      Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "*/"
    timescale :: Mon (State VerilogState) Doc
timescale = "`timescale 100fs/100fs"

sigPort :: Maybe WireOrReg
        -> TextS.Text
        -> HWType
        -> VerilogM Doc
sigPort :: Maybe WireOrReg
-> Identifier -> HWType -> Mon (State VerilogState) Doc
sigPort wor :: Maybe WireOrReg
wor pName :: Identifier
pName hwType :: HWType
hwType =
    [Attr']
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
addAttrs (HWType -> [Attr']
hwTypeAttrs HWType
hwType)
      (Mon (State VerilogState) Doc
portType Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VerilogState) Doc
verilogType HWType
hwType Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
pName Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State VerilogState) Doc
forall (m :: * -> *). Applicative m => HWType -> m Doc
encodingNote HWType
hwType)
  where
    portType :: Mon (State VerilogState) Doc
portType = case Maybe WireOrReg
wor of
                 Nothing   -> if HWType -> Bool
isBiSignalIn HWType
hwType then "inout" else "input"
                 Just Wire -> "output" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> "wire"
                 Just Reg  -> "output" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> "reg"

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

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

    inPorts :: Mon (State VerilogState) [Doc]
inPorts  = [Mon (State VerilogState) Doc] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Maybe WireOrReg
-> Identifier -> HWType -> Mon (State VerilogState) Doc
sigPort Maybe WireOrReg
forall a. Maybe a
Nothing Identifier
id_ HWType
hwType | (id_ :: Identifier
id_, hwType :: HWType
hwType) <- Component -> [(Identifier, HWType)]
inputs Component
c  ]
    outPorts :: Mon (State VerilogState) [Doc]
outPorts = [Mon (State VerilogState) Doc] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Maybe WireOrReg
-> Identifier -> HWType -> Mon (State VerilogState) Doc
sigPort (WireOrReg -> Maybe WireOrReg
forall a. a -> Maybe a
Just WireOrReg
wireOrReg) Identifier
id_ HWType
hwType | (wireOrReg :: WireOrReg
wireOrReg, (id_ :: Identifier
id_, hwType :: HWType
hwType)) <- Component -> [(WireOrReg, (Identifier, HWType))]
outputs Component
c ]

    -- slightly more readable than 'tupled', makes the output Haskell-y-er
    commafy :: Doc -> f Doc
commafy v :: Doc
v = (f Doc
forall (f :: * -> *). Applicative f => f Doc
comma f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: * -> *). Applicative f => f Doc
space) f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> f Doc
forall (f :: * -> *) 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 :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      []     -> m Doc
forall (f :: * -> *). Applicative f => f Doc
lparen m Doc -> m Doc -> m Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Text -> m Doc
forall (f :: * -> *). 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 :: * -> *). Applicative f => f Doc
line
      (x :: Doc
x:xs :: [Doc]
xs) -> m Doc
forall (f :: * -> *). Applicative f => f Doc
lparen m Doc -> m Doc -> m Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Text -> m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "// Inputs"
                      m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: * -> *). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> (Text -> m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "  " m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> m Doc
forall (f :: * -> *) 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 :: * -> *). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m [Doc] -> m Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
vcat ([Doc] -> (Doc -> m Doc) -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Doc]
xs Doc -> m Doc
forall (f :: * -> *).
(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 :: * -> *). 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 :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      []     -> Text -> m Doc
forall (f :: * -> *). 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 :: * -> *). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: * -> *). Applicative f => f Doc
rparen
      (x :: Doc
x:xs :: [Doc]
xs) -> Text -> m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "  // Outputs"
                  m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: * -> *). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> (if ([(Identifier, HWType)] -> Int
forall (t :: * -> *) 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 :: * -> *). Applicative f => f Doc
comma m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: * -> *). Applicative f => f Doc
space m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> m Doc
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
x
                         else Text -> m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "  " m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> m Doc
forall (f :: * -> *) 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 :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
xs then m Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc else m Doc
forall (f :: * -> *). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m [Doc] -> m Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
vcat ([Doc] -> (Doc -> m Doc) -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Doc]
xs Doc -> m Doc
forall (f :: * -> *).
(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 :: * -> *). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: * -> *). Applicative f => f Doc
rparen

include :: Monad m => [Text.Text] -> Mon m Doc
include :: [Text] -> Mon m Doc
include [] = Mon m Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc
include xs :: [Text]
xs = Mon m Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>
  Int -> Mon m Doc -> Mon m Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
indent 2 (Mon m [Doc] -> Mon m Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
vcat ((Text -> Mon m Doc) -> [Text] -> Mon m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\i :: Text
i -> Text -> Mon m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "`include" Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon m Doc -> Mon m Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
dquotes (Text -> Mon m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string Text
i)) [Text]
xs))
  Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
forall (f :: * -> *). Applicative f => f Doc
line

uselibs :: Monad m => [Text.Text] -> Mon m Doc
uselibs :: [Text] -> Mon m Doc
uselibs [] = Mon m Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc
uselibs xs :: [Text]
xs = Mon m Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>
  -- NOTE: We must produce a single uselib directive as later ones overwrite earlier ones.
  Int -> Mon m Doc -> Mon m Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
indent 2 (Text -> Mon m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "`uselib" Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> (Mon m [Doc] -> Mon m Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
hsep ((Text -> Mon m Doc) -> [Text] -> Mon m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\l :: Text
l -> ("lib=" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string Text
l)) [Text]
xs)))
  Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
forall (f :: * -> *). Applicative f => f Doc
line

wireOrRegDoc :: WireOrReg -> VerilogM Doc
wireOrRegDoc :: WireOrReg -> Mon (State VerilogState) Doc
wireOrRegDoc Wire = "wire"
wireOrRegDoc Reg  = "reg"

addSeen :: Component -> VerilogM ()
addSeen :: Component -> Mon (State VerilogState) ()
addSeen c :: Component
c = do
  let iport :: [Identifier]
iport = [Identifier
iName | (iName :: Identifier
iName, _) <- Component -> [(Identifier, HWType)]
inputs Component
c]
      oport :: [Identifier]
oport = [Identifier
oName | (_, (oName :: Identifier
oName, _)) <- Component -> [(WireOrReg, (Identifier, HWType))]
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 VerilogState () -> Mon (State VerilogState) ()
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState () -> Mon (State VerilogState) ())
-> State VerilogState () -> Mon (State VerilogState) ()
forall a b. (a -> b) -> a -> b
$ (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VerilogState -> Identity VerilogState
Lens' VerilogState (HashMap Identifier Word)
idSeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> VerilogState -> Identity VerilogState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State VerilogState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Word -> Word -> Word)
-> HashMap Identifier Word
-> HashMap Identifier Word
-> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith Word -> Word -> Word
forall a. Ord a => a -> a -> a
max ([(Identifier, Word)] -> HashMap Identifier Word
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (([Identifier] -> [(Identifier, Word)])
-> [[Identifier]] -> [(Identifier, Word)]
forall (t :: * -> *) 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])))

verilogType :: HWType -> VerilogM Doc
verilogType :: HWType -> Mon (State VerilogState) Doc
verilogType t :: HWType
t = case HWType
t of
  Signed n :: Int
n -> "signed" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
colon Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int 0)
  Clock {} -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc
  Reset {} -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc
  Bit      -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc
  Bool     -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc
  _        -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t Int -> Int -> Int
forall a. Num a => a -> a -> a
-1) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
colon Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int 0)

sigDecl :: VerilogM Doc -> HWType -> VerilogM Doc
sigDecl :: Mon (State VerilogState) Doc
-> HWType -> Mon (State VerilogState) Doc
sigDecl d :: Mon (State VerilogState) Doc
d t :: HWType
t = HWType -> Mon (State VerilogState) Doc
verilogType HWType
t Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
d

-- | Convert a Netlist HWType to the root of a Verilog type
verilogTypeMark :: HWType -> VerilogM Doc
verilogTypeMark :: HWType -> Mon (State VerilogState) Doc
verilogTypeMark = Mon (State VerilogState) Doc
-> HWType -> Mon (State VerilogState) Doc
forall a b. a -> b -> a
const Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc

-- | Convert a Netlist HWType to an error Verilog value for that type
verilogTypeErrValue :: HWType -> VerilogM Doc
verilogTypeErrValue :: HWType -> Mon (State VerilogState) Doc
verilogTypeErrValue ty :: HWType
ty = do
  Maybe (Maybe Int)
udf <- State VerilogState (Maybe (Maybe Int))
-> Mon (State VerilogState) (Maybe (Maybe Int))
forall (f :: * -> *) m. f m -> Mon f m
Mon (Getting (Maybe (Maybe Int)) VerilogState (Maybe (Maybe Int))
-> State VerilogState (Maybe (Maybe Int))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe (Maybe Int)) VerilogState (Maybe (Maybe Int))
Lens' VerilogState (Maybe (Maybe Int))
undefValue)
  case Maybe (Maybe Int)
udf of
    Nothing       -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
braces (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
braces "1'bx")
    Just Nothing  -> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "'d0 /* undefined */"
    Just (Just x :: Int
x) -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
braces (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
braces ("1'b" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
x)) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> "/* undefined */"

verilogRecSel
  :: HWType
  -> Int
  -> VerilogM Doc
verilogRecSel :: HWType -> Int -> Mon (State VerilogState) Doc
verilogRecSel ty :: HWType
ty i :: Int
i = case Int -> Modifier -> Maybe (Int, Int, HWType)
modifier 0 ((HWType, Int, Int) -> Modifier
Indexed (HWType
ty,0,Int
i)) of
  Just (start :: Int
start,end :: Int
end,_resTy :: HWType
_resTy) -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
start Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
colon Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
end)
  _ -> String -> Mon (State VerilogState) Doc
forall a. HasCallStack => String -> a
error "Can't make a record selector"

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

-- | Add attribute notation to given declaration
addAttrs
  :: [Attr']
  -> VerilogM Doc
  -> VerilogM Doc
addAttrs :: [Attr']
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
addAttrs []     t :: Mon (State VerilogState) Doc
t = Mon (State VerilogState) Doc
t
addAttrs attrs' :: [Attr']
attrs' t :: Mon (State VerilogState) Doc
t =
  "(*" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
attrs'' Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> "*)" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
t
 where
  attrs'' :: Mon (State VerilogState) Doc
attrs'' = Text -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string (Text -> Mon (State VerilogState) Doc)
-> Text -> Mon (State VerilogState) 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')

-- | Convert single attribute to verilog syntax
renderAttr :: Attr' -> Text.Text
renderAttr :: Attr' -> Text
renderAttr (StringAttr'  key :: String
key value :: String
value) = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) 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
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) 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
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
key, " = ", "1"]
renderAttr (BoolAttr'    key :: String
key False) = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
key, " = ", "0"]
renderAttr (Attr'        key :: String
key      ) = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
key

decl :: Declaration -> VerilogM (Maybe Doc)
decl :: Declaration -> Mon (State VerilogState) (Maybe Doc)
decl (NetDecl' noteM :: Maybe Identifier
noteM wr :: WireOrReg
wr id_ :: Identifier
id_ tyE :: Either Identifier HWType
tyE) =
  Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc)
-> (Identifier
    -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Maybe Identifier
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. a -> a
id Identifier
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *).
(Monoid (f Doc), Applicative f, IsString (f Doc)) =>
Identifier -> f Doc -> f Doc
addNote Maybe Identifier
noteM ([Attr']
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
addAttrs [Attr']
attrs (WireOrReg -> Mon (State VerilogState) Doc
wireOrRegDoc WireOrReg
wr Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Either Identifier HWType -> Mon (State VerilogState) Doc
tyDec Either Identifier HWType
tyE))
  where
    tyDec :: Either Identifier HWType -> Mon (State VerilogState) Doc
tyDec (Left  ty :: Identifier
ty) = Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
ty Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_
    tyDec (Right ty :: HWType
ty) = Mon (State VerilogState) Doc
-> HWType -> Mon (State VerilogState) Doc
sigDecl (Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_) HWType
ty
    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 :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> f Doc
forall (f :: * -> *). 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 :: * -> *). 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 :: * -> *) 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)

decl _ = Maybe Doc -> Mon (State VerilogState) (Maybe Doc)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing

insts :: [Declaration] -> VerilogM Doc
insts :: [Declaration] -> Mon (State VerilogState) Doc
insts [] = Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc
insts (TickDecl id_ :: Identifier
id_:ds :: [Declaration]
ds) = "//" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State VerilogState) Doc
insts [Declaration]
ds
insts (d :: Declaration
d:ds :: [Declaration]
ds) = do
  Maybe Doc
docM <- Declaration -> Mon (State VerilogState) (Maybe Doc)
inst_ Declaration
d
  case Maybe Doc
docM of
    Nothing -> [Declaration] -> Mon (State VerilogState) Doc
insts [Declaration]
ds
    Just doc :: Doc
doc -> Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
doc Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State VerilogState) 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'
  -> VerilogM Doc
patLitCustom' :: Int -> ConstrRepr' -> Mon (State VerilogState) Doc
patLitCustom' size :: Int
size (ConstrRepr' _name :: Identifier
_name _n :: Int
_n mask :: Integer
mask value :: Integer
value _anns :: [Integer]
_anns) =
  Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
size Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
squote Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "b" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> (Text -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string (Text -> Mon (State VerilogState) Doc)
-> Text -> Mon (State VerilogState) 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
  -> VerilogM Doc
patLitCustom :: HWType -> Literal -> Mon (State VerilogState) 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 VerilogState) 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 VerilogState) Doc
patLitCustom' Int
size ConstrRepr'
cRepr

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

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

      conds :: [(Maybe Literal,Expr)] -> VerilogM Doc
      conds :: [(Maybe Literal, Expr)] -> Mon (State VerilogState) Doc
conds []                = String -> Mon (State VerilogState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VerilogState) Doc)
-> String -> Mon (State VerilogState) 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 VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> ":" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> "=" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> ";"
      conds ((Nothing,e :: Expr
e):_)   = "default" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> ":" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> "=" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> ";"
      conds ((Just c :: Literal
c ,e :: Expr
e):es' :: [(Maybe Literal, Expr)]
es') =
        Mon (State VerilogState) Doc
mask' Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> ":" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> "=" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> ";" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [(Maybe Literal, Expr)] -> Mon (State VerilogState) Doc
conds [(Maybe Literal, Expr)]
es'
          where
            mask' :: Mon (State VerilogState) Doc
mask' = HWType -> Literal -> Mon (State VerilogState) Doc
patLitCustom HWType
scrutTy Literal
c

-- | Turn a Netlist Declaration to a Verilog concurrent block
inst_ :: Declaration -> VerilogM (Maybe Doc)
inst_ :: Declaration -> Mon (State VerilogState) (Maybe Doc)
inst_ (TickDecl {}) = Maybe Doc -> Mon (State VerilogState) (Maybe Doc)
forall (m :: * -> *) 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 VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VerilogState) Doc
 -> Mon (State VerilogState) (Maybe Doc))
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  "assign" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
equals Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
semi

inst_ (CondAssignment id_ :: Identifier
id_ _ scrut :: Expr
scrut _ [(Just (BoolLit b :: Bool
b), l :: Expr
l),(_,r :: Expr
r)]) = (Doc -> Maybe Doc)
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VerilogState) Doc
 -> Mon (State VerilogState) (Maybe Doc))
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
   "always @(*) begin" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
   Int -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
indent 2 ("if" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
True Expr
scrut) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
               (Int -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
indent 2 (Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
equals Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
t Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
semi) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
            "else" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
               (Int -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
indent 2 (Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
equals Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
f Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
semi)) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) 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 VerilogState) (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 VerilogState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es

inst_ (CondAssignment id_ :: Identifier
id_ _ scrut :: Expr
scrut scrutTy :: HWType
scrutTy es :: [(Maybe Literal, Expr)]
es) = (Doc -> Maybe Doc)
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VerilogState) Doc
 -> Mon (State VerilogState) (Maybe Doc))
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
    "always @(*) begin" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
indent 2 ("case" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
True Expr
scrut) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
                (Int -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
indent 2 (Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
vcat (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VerilogState) Doc
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall (f :: * -> *). Applicative f => f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
semi (Identifier
-> [(Maybe Literal, Expr)] -> Mon (State VerilogState) [Doc]
conds Identifier
id_ [(Maybe Literal, Expr)]
es)) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
semi Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
              "endcase") Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
    "end"
  where
    conds :: Identifier -> [(Maybe Literal,Expr)] -> VerilogM [Doc]
    conds :: Identifier
-> [(Maybe Literal, Expr)] -> Mon (State VerilogState) [Doc]
conds _ []                = [Doc] -> Mon (State VerilogState) [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    conds i :: Identifier
i [(_,e :: Expr
e)]           = ("default" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
colon Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
i Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
equals Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e) Mon (State VerilogState) Doc
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall (f :: * -> *) a. Applicative f => f a -> f [a] -> f [a]
<:> [Doc] -> Mon (State VerilogState) [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    conds i :: Identifier
i ((Nothing,e :: Expr
e):_)   = ("default" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
colon Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
i Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
equals Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e) Mon (State VerilogState) Doc
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall (f :: * -> *) a. Applicative f => f a -> f [a] -> f [a]
<:> [Doc] -> Mon (State VerilogState) [Doc]
forall (m :: * -> *) 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 VerilogState) Doc
exprLitV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
scrutTy,HWType -> Int
conSize HWType
scrutTy)) Literal
c Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
colon Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
i Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
equals Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e) Mon (State VerilogState) Doc
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall (f :: * -> *) a. Applicative f => f a -> f [a] -> f [a]
<:> Identifier
-> [(Maybe Literal, Expr)] -> Mon (State VerilogState) [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 VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VerilogState) Doc
 -> Mon (State VerilogState) (Maybe Doc))
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
    Int -> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => Int -> f Doc -> f Doc
nest 2 (Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
nm Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
params Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
lbl Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
pms' Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
semi)
  where
    pms' :: Mon (State VerilogState) Doc
pms' = Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
tupled (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VerilogState) Doc] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
dot Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
i Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e) | (i :: Expr
i,_,_,e :: Expr
e) <- [(Expr, PortDirection, HWType, Expr)]
pms]
    params :: Mon (State VerilogState) Doc
params
      | [(Expr, HWType, Expr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Expr, HWType, Expr)]
ps   = Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
space
      | Bool
otherwise = Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
line Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "#" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
tupled ([Mon (State VerilogState) Doc] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
dot Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
i Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e) | (i :: Expr
i,_,e :: Expr
e) <- [(Expr, HWType, Expr)]
ps]) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). 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 VerilogState) Doc
-> Mon (State VerilogState) (Maybe Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (State VerilogState Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *) m. f m -> Mon f m
Mon (StateT VerilogState Identity (Int -> Doc) -> State VerilogState Doc
forall (f :: * -> *). Functor f => f (Int -> Doc) -> f Doc
column ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VerilogState 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_ (NetDecl' _ _ _ _) = Maybe Doc -> Mon (State VerilogState) (Maybe Doc)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing

-- | Calculate the beginning and end index into a variable, to get the
-- desired field.
-- Also returns the HWType of the result.
modifier
  :: Int
  -- ^ Offset, only used when we have nested modifiers
  -> Modifier
  -> Maybe (Int,Int,HWType)
modifier :: Int -> Modifier -> Maybe (Int, Int, HWType)
modifier offset :: Int
offset (Sliced (BitVector _,start :: Int
start,end :: Int
end)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (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, 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 (Indexed (ty :: HWType
ty@(SP _ args :: [(Identifier, [HWType])]
args),dcI :: Int
dcI,fI :: Int
fI)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (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, 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 (Indexed (ty :: HWType
ty@(Product _ _ argTys :: [HWType]
argTys),_,fI :: Int
fI)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (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, 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 (Indexed (ty :: HWType
ty@(Vector _ argTy :: HWType
argTy),1,0)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (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, 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 (Indexed (ty :: HWType
ty@(Vector _ argTy :: HWType
argTy),1,1)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset,Int
offset, 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 (Indexed (ty :: HWType
ty@(RTree 0 argTy :: HWType
argTy),0,0)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset,Int
offset, 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 (Indexed (ty :: HWType
ty@(RTree _ argTy :: HWType
argTy),1,0)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (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, 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

modifier offset :: Int
offset (Indexed (ty :: HWType
ty@(RTree _ argTy :: HWType
argTy),1,1)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset,Int
offset, 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

-- 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 (Indexed (ty :: HWType
ty@(Vector _ argTy :: HWType
argTy),10,fI :: Int
fI)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (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, 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 (Indexed (ty :: HWType
ty@(RTree _ argTy :: HWType
argTy),10,fI :: Int
fI)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (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, 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 (Indexed (CustomSP _id :: Identifier
_id _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)] -> (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (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, HWType
argTy)
    _ -> String -> Maybe (Int, Int, HWType)
forall a. HasCallStack => String -> a
error ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Cannot handle projection out of a non-contiguously encoded field")
 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 (DC (ty :: HWType
ty@(SP _ _),_)) = (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (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, 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 (Nested m1 :: Modifier
m1 m2 :: Modifier
m2) = do
  case Int -> Modifier -> Maybe (Int, Int, HWType)
modifier Int
offset Modifier
m1 of
    Nothing    -> Int -> Modifier -> Maybe (Int, Int, HWType)
modifier Int
offset Modifier
m2
    Just (s :: Int
s,e :: Int
e,argTy :: HWType
argTy) -> case Int -> Modifier -> Maybe (Int, Int, HWType)
modifier Int
e Modifier
m2 of
      -- In case the second modifier is `Nothing` that means we want the entire
      -- thing calculated by the first modifier
      Nothing -> (Int, Int, HWType) -> Maybe (Int, Int, HWType)
forall a. a -> Maybe a
Just (Int
s,Int
e,HWType
argTy)
      m :: Maybe (Int, Int, HWType)
m       -> Maybe (Int, Int, HWType)
m

modifier _ _ = Maybe (Int, Int, HWType)
forall a. Maybe a
Nothing

-- | Turn a Netlist expression into a Verilog expression
expr_ :: Bool -- ^ Enclose in parentheses?
      -> Expr -- ^ Expr to convert
      -> VerilogM Doc
expr_ :: Bool -> Expr -> Mon (State VerilogState) Doc
expr_ _ (Literal sizeM :: Maybe (HWType, Int)
sizeM lit :: Literal
lit) = Maybe (HWType, Int) -> Literal -> Mon (State VerilogState) Doc
exprLitV Maybe (HWType, Int)
sizeM Literal
lit

expr_ _ (Identifier id_ :: Identifier
id_ Nothing) = Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). 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)))) =
  Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
braces (Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
hcat (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VerilogState) Doc
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall (f :: * -> *). Applicative f => f Doc -> f [Doc] -> f [Doc]
punctuate ", " (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc])
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Mon (State VerilogState) Doc] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VerilogState) Doc]
ranges
    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
      ranges :: [Mon (State VerilogState) Doc]
ranges = ((Int, Int) -> Mon (State VerilogState) Doc)
-> [(Int, Int)] -> [Mon (State VerilogState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Mon (State VerilogState) Doc
forall (f :: * -> *).
(Semigroup (f Doc), Applicative f, IsString (f Doc)) =>
(Int, Int) -> f Doc
range' ([(Int, Int)] -> [Mon (State VerilogState) Doc])
-> [(Int, Int)] -> [Mon (State VerilogState) 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 :: * -> *). 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 :: * -> *). Functor f => f Doc -> f Doc
brackets (Int -> f Doc
forall (f :: * -> *). 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 :: * -> *). Applicative f => Int -> f Doc
int Int
end)

-- See [Note] integer projection
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Signed w :: Int
w),_,_))))  = do
  Int
iw <- State VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState Int -> Mon (State VerilogState) Int)
-> State VerilogState Int -> Mon (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Bool
-> String
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) 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 VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$
    Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). 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 VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState Int -> Mon (State VerilogState) Int)
-> State VerilogState Int -> Mon (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Bool
-> String
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) 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 VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$
    Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_

-- See [Note] mask projection
expr_ _ (Identifier _ (Just (Indexed ((BitVector _),_,0)))) = do
  Int
iw <- State VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState Int -> Mon (State VerilogState) Int)
-> State VerilogState Int -> Mon (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Bool
-> String
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) 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 VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$
    HWType -> Mon (State VerilogState) 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 VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState Int -> Mon (State VerilogState) Int)
-> State VerilogState Int -> Mon (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Bool
-> String
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) 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 VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$
    Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_

expr_ _ (Identifier id_ :: Identifier
id_ (Just m :: Modifier
m)) = case Int -> Modifier -> Maybe (Int, Int, HWType)
modifier 0 Modifier
m of
  Nothing          -> Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_
  Just (start :: Int
start,end :: Int
end,resTy :: HWType
resTy) -> case HWType
resTy of
    Signed _ -> "$signed" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
start Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
colon Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
end))
    _        ->                      Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
start Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
colon Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
end)

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

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

expr_ _ (DataCon (Vector 1 _) _ [e :: Expr
e]) = Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e
expr_ _ e :: Expr
e@(DataCon (Vector _ _) _ es :: [Expr]
es@[_,_]) =
  case Expr -> Maybe [Expr]
vectorChain Expr
e of
    Just es' :: [Expr]
es' -> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (m :: * -> *). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> Mon (State VerilogState) Doc)
-> [Expr] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False) [Expr]
es')
    Nothing  -> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (m :: * -> *). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> Mon (State VerilogState) Doc)
-> [Expr] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False) [Expr]
es)

expr_ _ (DataCon (RTree 0 _) _ [e :: Expr
e]) = Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False Expr
e
expr_ _ e :: Expr
e@(DataCon (RTree _ _) _ es :: [Expr]
es@[_,_]) =
  case Expr -> Maybe [Expr]
rtreeChain Expr
e of
    Just es' :: [Expr]
es' -> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (m :: * -> *). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> Mon (State VerilogState) Doc)
-> [Expr] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False) [Expr]
es')
    Nothing  -> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (m :: * -> *). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> Mon (State VerilogState) Doc)
-> [Expr] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False) [Expr]
es)

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

expr_ _ (DataCon ty :: HWType
ty@(SP _ args :: [(Identifier, [HWType])]
args) (DC (_,i :: Int
i)) es :: [Expr]
es) = Mon (State VerilogState) 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 :: * -> *) 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 VerilogState) Doc
dcExpr     = Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
    argExprs :: [Mon (State VerilogState) Doc]
argExprs   = (Expr -> Mon (State VerilogState) Doc)
-> [Expr] -> [Mon (State VerilogState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False) [Expr]
es
    extraArg :: [Mon (State VerilogState) 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 VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
n Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "'b" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Lens' VerilogState (Maybe (Maybe Int))
-> [Bit] -> Mon (State VerilogState) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> [Bit] -> Mon (State s) Doc
bits Lens' VerilogState (Maybe (Maybe Int))
undefValue (Int -> Bit -> [Bit]
forall a. Int -> a -> [a]
replicate Int
n Bit
U)]
    assignExpr :: Mon (State VerilogState) Doc
assignExpr = Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
braces (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
hcat (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VerilogState) Doc
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall (f :: * -> *). Applicative f => f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
comma (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc])
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Mon (State VerilogState) Doc] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Mon (State VerilogState) Doc
dcExprMon (State VerilogState) Doc
-> [Mon (State VerilogState) Doc] -> [Mon (State VerilogState) Doc]
forall a. a -> [a] -> [a]
:[Mon (State VerilogState) Doc]
argExprs [Mon (State VerilogState) Doc]
-> [Mon (State VerilogState) Doc] -> [Mon (State VerilogState) Doc]
forall a. [a] -> [a] -> [a]
++ [Mon (State VerilogState) Doc]
extraArg))

expr_ _ (DataCon ty :: HWType
ty@(Sum _ _) (DC (_,i :: Int
i)) []) = Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "'d" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). 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 VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
squote Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "d" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
value)
expr_ _ (DataCon (CustomSP name' :: Identifier
name' dataRepr :: DataRepr'
dataRepr size :: Int
size args :: [(ConstrRepr', Identifier, [HWType])]
args) (DC (_,constrNr :: Int
constrNr)) es :: [Expr]
es) =
  ((Mon (State VerilogState) Doc
 -> Maybe (Mon (State VerilogState) Doc)
 -> Mon (State VerilogState) Doc)
-> Maybe (Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip Mon (State VerilogState) Doc
-> Maybe (Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc
forall a. a -> Maybe a -> a
fromMaybe) (Int -> [Integer] -> Maybe (Mon (State VerilogState) Doc)
forall a. Int -> [Integer] -> Maybe a
errOnNonContinuous 0 [Integer]
anns) (Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$
  Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
braces (Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
hcat (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc)
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VerilogState) Doc
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall (f :: * -> *). Applicative f => f Doc -> f [Doc] -> f [Doc]
punctuate ", " (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc])
-> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ (BitOrigin -> Mon (State VerilogState) Doc)
-> [BitOrigin] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BitOrigin -> Mon (State VerilogState) Doc
range' [BitOrigin]
origins
    where
      (cRepr :: ConstrRepr'
cRepr, _, _) = [(ConstrRepr', Identifier, [HWType])]
args [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
constrNr
      (ConstrRepr' _name :: Identifier
_name _n :: Int
_n _mask :: Integer
_mask _value :: Integer
_value anns :: [Integer]
anns) = ConstrRepr'
cRepr

      errOnNonContinuous :: Int -> [BitMask] -> Maybe a
      errOnNonContinuous :: Int -> [Integer] -> Maybe a
errOnNonContinuous _ [] = Maybe a
forall a. Maybe a
Nothing
      errOnNonContinuous fieldnr :: Int
fieldnr (ann :: Integer
ann:anns' :: [Integer]
anns') =
        if Integer -> Bool
isContinuousMask Integer
ann then
          Int -> [Integer] -> Maybe a
forall a. Int -> [Integer] -> Maybe a
errOnNonContinuous (Int
fieldnr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [Integer]
anns'
        else
          String -> Maybe a
forall a. HasCallStack => String -> a
error (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [
              "Error while processing custom bit representation:\n"
            , [String] -> String
unwords ["Field", Int -> String
forall a. Show a => a -> String
show Int
fieldnr, "of constructor", Int -> String
forall a. Show a => a -> String
show Int
constrNr, "of type\n"]
            , "  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
name' String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n"
            , "has a non-continuous fieldmask:\n"
            , "  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Bit -> Char) -> [Bit] -> String
forall a b. (a -> b) -> [a] -> [b]
map Bit -> Char
bit_char' ([Bit] -> String) -> [Bit] -> String
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
size Integer
ann) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n"
            , [String] -> String
unwords [ "This is not supported in Verilog. Change the mask to a"
                      , "continuous one, or render using VHDL or SystemVerilog."
                      ]
            ]

      -- Build bit representations for all constructor arguments
      argExprs :: [Mon (State VerilogState) Doc]
argExprs = (Expr -> Mon (State VerilogState) Doc)
-> [Expr] -> [Mon (State VerilogState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False) [Expr]
es :: [VerilogM Doc]

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

      range'
        :: BitOrigin
        -> VerilogM Doc
      range' :: BitOrigin -> Mon (State VerilogState) Doc
range' (Lit ([Bit] -> [Bit]
bitsToBits -> [Bit]
ns)) =
        Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int ([Bit] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bit]
ns) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
squote Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "b" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
hcat ((Bit -> Mon (State VerilogState) Doc)
-> [Bit] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Lens' VerilogState (Maybe (Maybe Int))
-> Bit -> Mon (State VerilogState) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Mon (State s) Doc
bit_char Lens' VerilogState (Maybe (Maybe Int))
undefValue) [Bit]
ns)
      range' (Field n :: Int
n _start :: Int
_start _end :: Int
_end) =
        [Mon (State VerilogState) Doc]
argExprs [Mon (State VerilogState) Doc]
-> Int -> Mon (State VerilogState) Doc
forall a. [a] -> Int -> a
!! Int
n

expr_ _ (DataCon (Product {}) _ es :: [Expr]
es) = Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (m :: * -> *). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> Mon (State VerilogState) Doc)
-> [Expr] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
False) [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 VerilogState) Doc
exprLitV ((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 VerilogState) Doc
exprLitV ((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 _ 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 VerilogState) Doc
exprLitV ((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 VerilogState) Doc
exprLitV ((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
  = Lens' VerilogState (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Mon (State VerilogState) Doc
forall s.
Lens' s (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Mon (State s) Doc
exprLit Lens' VerilogState (Maybe (Maybe Int))
undefValue ((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') = do
  Bool
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (m :: * -> *). Monad m => Bool -> m Doc -> m Doc
parenIf (Bool
b Bool -> Bool -> Bool
|| Bool
b') (State VerilogState Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *) m. f m -> Mon f m
Mon ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VerilogState 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 VerilogState Identity (Int -> Doc)
-> State VerilogState Int -> State VerilogState Doc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> State VerilogState Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0))

expr_ _ (DataTag Bool (Left id_ :: Identifier
id_))          = Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
brackets (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int 0)
expr_ _ (DataTag Bool (Right id_ :: Identifier
id_))         = do
  Int
iw <- State VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth)
  "$unsigned" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
parens (Mon (State VerilogState) [Doc] -> Mon (State VerilogState) Doc
forall (m :: * -> *). Monad m => m [Doc] -> m Doc
listBraces ([Mon (State VerilogState) Doc] -> Mon (State VerilogState) [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
braces (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (Int
iwInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
<+> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
braces "1'b0"),Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_]))

expr_ _ (DataTag (Sum _ _) (Left id_ :: Identifier
id_))     = "$unsigned" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_)
expr_ _ (DataTag (Sum _ _) (Right id_ :: Identifier
id_))    = "$unsigned" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_)

expr_ _ (DataTag (Product {}) (Right _))  = do
  Int
iw <- State VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth)
  Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
iw Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "'sd0"

expr_ _ (DataTag hty :: HWType
hty@(SP _ _) (Right id_ :: Identifier
id_)) = "$unsigned" Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
parens
                                               (Identifier -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Identifier -> f Doc
stringS Identifier
id_ Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall (f :: * -> *). Functor f => f Doc -> f Doc
brackets
                                               (Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
start Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => f Doc
colon Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). 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 VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState Int -> Mon (State VerilogState) Int)
-> State VerilogState Int -> Mon (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
iw Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "'sd0"
expr_ _ (DataTag (Vector _ _) (Right _)) = do
  Int
iw <- State VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState Int -> Mon (State VerilogState) Int)
-> State VerilogState Int -> Mon (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
iw Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "'sd1"

expr_ _ (DataTag (RTree 0 _) (Right _)) = do
  Int
iw <- State VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState Int -> Mon (State VerilogState) Int)
-> State VerilogState Int -> Mon (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
iw Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "'sd0"
expr_ _ (DataTag (RTree _ _) (Right _)) = do
  Int
iw <- State VerilogState Int -> Mon (State VerilogState) Int
forall (f :: * -> *) m. f m -> Mon f m
Mon (State VerilogState Int -> Mon (State VerilogState) Int)
-> State VerilogState Int -> Mon (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Int -> Mon (State VerilogState) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
iw Mon (State VerilogState) Doc
-> Mon (State VerilogState) Doc -> Mon (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> "'sd1"

expr_ b :: Bool
b (ConvBV _ _ _ e :: Expr
e) = Bool -> Expr -> Mon (State VerilogState) Doc
expr_ Bool
b Expr
e

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

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

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

vectorChain :: Expr -> Maybe [Expr]
vectorChain :: Expr -> Maybe [Expr]
vectorChain (DataCon (Vector 0 _) _ _)        = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just []
vectorChain (DataCon (Vector 1 _) _ [e :: Expr
e])     = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just [Expr
e]
vectorChain (DataCon (Vector _ _) _ [e1 :: Expr
e1,e2 :: Expr
e2]) = Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e1 Maybe Expr -> Maybe [Expr] -> Maybe [Expr]
forall (f :: * -> *) 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 -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e1 Maybe Expr -> Maybe [Expr] -> Maybe [Expr]
forall (f :: * -> *) a. Applicative f => f a -> f [a] -> f [a]
<:> Expr -> Maybe [Expr]
rtreeChain Expr
e2
rtreeChain _                               = Maybe [Expr]
forall a. Maybe a
Nothing

exprLitV :: Maybe (HWType,Size) -> Literal -> VerilogM Doc
exprLitV :: Maybe (HWType, Int) -> Literal -> Mon (State VerilogState) Doc
exprLitV = Lens' VerilogState (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Mon (State VerilogState) Doc
forall s.
Lens' s (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Mon (State s) Doc
exprLit Lens' VerilogState (Maybe (Maybe Int))
undefValue

exprLit :: Lens' s (Maybe (Maybe Int)) -> Maybe (HWType,Size) -> Literal -> Mon (State s) Doc
exprLit :: Lens' s (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Mon (State s) Doc
exprLit _ Nothing (NumLit i :: Integer
i) = Integer -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Integer -> f Doc
integer Integer
i

exprLit k :: Lens' s (Maybe (Maybe Int))
k (Just (hty :: HWType
hty,sz :: Int
sz)) (NumLit i :: Integer
i) = case HWType
hty of
  Unsigned _
   | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0     -> Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "-" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
sz Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "'d" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Integer -> f Doc
integer (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
   | Bool
otherwise -> Int -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
sz Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "'d" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Integer -> f Doc
integer Integer
i
  Index _ -> Int -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
hty) Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "'d" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Integer -> f Doc
integer Integer
i
  Signed _
   | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0     -> Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "-" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
sz Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "'sd" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Integer -> f Doc
integer (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
   | Bool
otherwise -> Int -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
sz Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "'sd" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Integer -> f Doc
integer Integer
i
  _ -> Int -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
sz Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "'b" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State s) Doc
blit
  where
    blit :: Mon (State s) Doc
blit = Lens' s (Maybe (Maybe Int)) -> [Bit] -> Mon (State s) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> [Bit] -> Mon (State s) Doc
bits Lens' s (Maybe (Maybe Int))
k (Int -> Integer -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz Integer
i)
exprLit k :: Lens' s (Maybe (Maybe Int))
k (Just (_,sz :: Int
sz)) (BitVecLit m :: Integer
m i :: Integer
i) = Int -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
sz Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "'b" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State s) Doc
bvlit
  where
    bvlit :: Mon (State s) Doc
bvlit = Lens' s (Maybe (Maybe Int)) -> [Bit] -> Mon (State s) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> [Bit] -> Mon (State s) Doc
bits Lens' s (Maybe (Maybe Int))
k (Int -> Integer -> Integer -> [Bit]
forall a. Integral a => Int -> a -> a -> [Bit]
toBits' Int
sz Integer
m Integer
i)

exprLit _ _             (BoolLit t :: Bool
t)   = Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string (Text -> Mon (State s) Doc) -> Text -> Mon (State s) Doc
forall a b. (a -> b) -> a -> b
$ if Bool
t then "1'b1" else "1'b0"
exprLit k :: Lens' s (Maybe (Maybe Int))
k _             (BitLit b :: Bit
b)    = Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string "1'b" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Lens' s (Maybe (Maybe Int)) -> Bit -> Mon (State s) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Mon (State s) Doc
bit_char Lens' s (Maybe (Maybe Int))
k Bit
b
exprLit _ _             (StringLit s :: String
s) = Text -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string (Text -> Mon (State s) Doc)
-> (String -> Text) -> String -> Mon (State s) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Mon (State s) Doc) -> String -> Mon (State s) Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
s
exprLit _ _             l :: Literal
l             = String -> Mon (State s) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State s) Doc) -> String -> Mon (State s) Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "exprLit: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Literal -> String
forall a. Show a => a -> String
show Literal
l

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

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


bits :: Lens' s (Maybe (Maybe Int)) -> [Bit] -> Mon (State s) Doc
bits :: Lens' s (Maybe (Maybe Int)) -> [Bit] -> Mon (State s) Doc
bits k :: Lens' s (Maybe (Maybe Int))
k = Mon (State s) [Doc] -> Mon (State s) Doc
forall (f :: * -> *). Functor f => f [Doc] -> f Doc
hcat (Mon (State s) [Doc] -> Mon (State s) Doc)
-> ([Bit] -> Mon (State s) [Doc]) -> [Bit] -> Mon (State s) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bit -> Mon (State s) Doc) -> [Bit] -> Mon (State s) [Doc]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Lens' s (Maybe (Maybe Int)) -> Bit -> Mon (State s) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Mon (State s) Doc
bit_char Lens' s (Maybe (Maybe Int))
k)

bit_char' :: Bit -> Char
bit_char' :: Bit -> Char
bit_char' H = '1'
bit_char' L = '0'
bit_char' U = 'x'
bit_char' Z = 'z'

bit_char :: Lens' s (Maybe (Maybe Int)) -> Bit -> Mon (State s) Doc
bit_char :: Lens' s (Maybe (Maybe Int)) -> Bit -> Mon (State s) Doc
bit_char k :: Lens' s (Maybe (Maybe Int))
k b :: Bit
b = do
  Maybe (Maybe Int)
udf <- State s (Maybe (Maybe Int)) -> Mon (State s) (Maybe (Maybe Int))
forall (f :: * -> *) m. f m -> Mon f m
Mon (Getting (Maybe (Maybe Int)) s (Maybe (Maybe Int))
-> State s (Maybe (Maybe Int))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe (Maybe Int)) s (Maybe (Maybe Int))
Lens' s (Maybe (Maybe Int))
k)
  case (Maybe (Maybe Int)
udf,Bit
b) of
    (Just Nothing,U)  -> Char -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Char -> f Doc
char '0'
    (Just (Just i :: Int
i),U) -> "'" Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Int -> f Doc
int Int
i Mon (State s) Doc -> Mon (State s) Doc -> Mon (State s) Doc
forall a. Semigroup a => a -> a -> a
<> "'"
    _                 -> Char -> Mon (State s) Doc
forall (f :: * -> *). Applicative f => Char -> f Doc
char (Bit -> Char
bit_char' Bit
b)


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 :: * -> *). 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 :: * -> *).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep m Doc
forall (f :: * -> *). Applicative f => f Doc
lbrace m Doc
forall (f :: * -> *). Applicative f => f Doc
rbrace m Doc
forall (f :: * -> *). 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 :: * -> *). 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 :: * -> *). Functor f => f [Doc] -> f Doc
vcat (Mon m Doc -> Mon m [Doc] -> Mon m [Doc]
forall (f :: * -> *). Applicative f => f Doc -> f [Doc] -> f [Doc]
punctuate Mon m Doc
s Mon m [Doc]
d) Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
s

encodingNote :: Applicative m => HWType -> m Doc
encodingNote :: HWType -> m Doc
encodingNote (Clock _) = Text -> m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string " // clock"
encodingNote (Reset _) = Text -> m Doc
forall (f :: * -> *). Applicative f => Text -> f Doc
string " // reset"
encodingNote _         = m Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc