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

  Generate Verilog for assorted Netlist datatypes
-}

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

module Clash.Backend.Verilog
  ( VerilogState
  , include
  , uselibs
  , encodingNote
  , exprLit
  , bits
  , bit_char
  , noEmptyInit
  -- * split ranges
  , Range (..)
  , continueWithRange
  )
where

import qualified Control.Applicative                  as A
import           Control.Lens                         (Lens',(+=),(-=),(.=),(%=), makeLenses, use)
import           Control.Monad                        (forM)
import           Control.Monad.State                  (State)
import           Data.Bifunctor                       (first, second)
import           Data.Bits                            (Bits, testBit)
import qualified Data.ByteString.Char8                as B8
import           Data.Coerce                          (coerce)
import           Data.Function                        (on)
import           Data.HashMap.Strict                  (HashMap)
import qualified Data.HashMap.Strict                  as HashMap
import           Data.HashSet                         (HashSet)
import qualified Data.HashSet                         as HashSet
import           Data.Maybe                           (catMaybes, fromMaybe)
import           Data.Monoid                          (Ap(Ap))
import           Data.Monoid.Extra                    ()
import           Data.List
  (mapAccumL, mapAccumR, nubBy, foldl')
import           Data.List.Extra                      ((<:>))
import           Data.Text.Lazy                       (pack)
import qualified Data.Text.Lazy                       as Text
import qualified Data.Text                            as TextS
import           Data.Text.Prettyprint.Doc.Extra
import qualified System.FilePath
import           GHC.Stack                            (HasCallStack)

import           Clash.Annotations.Primitive          (HDL (..))
import           Clash.Annotations.BitRepresentation.ClashLib
  (bitsToBits)
import           Clash.Annotations.BitRepresentation.Internal
  (ConstrRepr'(..), DataRepr'(..), ConstrRepr'(..))
import           Clash.Annotations.BitRepresentation.Util
  (BitOrigin(Lit, Field), bitOrigins, bitRanges)
import           Clash.Annotations.SynthesisAttributes (Attr(..))
import           Clash.Backend
import           Clash.Backend.Verilog.Time           (periodToString)
import           Clash.Debug                          (traceIf)
import           Clash.Driver.Types                   (ClashOpts(..))
import           Clash.Explicit.BlockRam.Internal     (unpackNats)
import           Clash.Netlist.BlackBox.Types         (HdlSyn)
import           Clash.Netlist.BlackBox.Util
  (extractLiterals, renderBlackBox, renderFilePath)
import qualified Clash.Netlist.Id                     as Id
import           Clash.Netlist.Types as N             hiding (intWidth, usages, _usages)
import           Clash.Netlist.Util
import           Clash.Signal.Internal                (ActiveEdge (..))
import           Clash.Util
  (SrcSpan, noSrcSpan, curLoc, indexNote, makeCached)

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

makeLenses ''VerilogState

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

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

instance Backend VerilogState where
  initBackend :: ClashOpts -> VerilogState
initBackend ClashOpts
opts = VerilogState
    { _genDepth :: Int
_genDepth=Int
0
    , _idSeen :: IdentifierSet
_idSeen=Bool -> PreserveCase -> HDL -> IdentifierSet
Id.emptyIdentifierSet (ClashOpts -> Bool
opt_escapedIds ClashOpts
opts) (ClashOpts -> PreserveCase
opt_lowerCaseBasicIds ClashOpts
opts) HDL
Verilog
    , _topNm :: Identifier
_topNm=HasCallStack => Text -> Identifier
Text -> Identifier
Id.unsafeMake Text
""
    , _srcSpan :: SrcSpan
_srcSpan=SrcSpan
noSrcSpan
    , _includes :: [([Char], Doc)]
_includes=[]
    , _imports :: HashSet Text
_imports=HashSet Text
forall a. HashSet a
HashSet.empty
    , _libraries :: HashSet Text
_libraries=HashSet Text
forall a. HashSet a
HashSet.empty
    , _dataFiles :: [([Char], [Char])]
_dataFiles=[]
    , _memoryDataFiles :: [([Char], [Char])]
_memoryDataFiles=[]
    , _customConstrs :: HashMap Text Identifier
_customConstrs=HashMap Text Identifier
forall k v. HashMap k v
HashMap.empty
    , _intWidth :: Int
_intWidth=ClashOpts -> Int
opt_intWidth ClashOpts
opts
    , _hdlsyn :: HdlSyn
_hdlsyn=ClashOpts -> HdlSyn
opt_hdlSyn ClashOpts
opts
    , _undefValue :: Maybe (Maybe Int)
_undefValue=ClashOpts -> Maybe (Maybe Int)
opt_forceUndefined ClashOpts
opts
    , _aggressiveXOptBB_ :: AggressiveXOptBB
_aggressiveXOptBB_=Bool -> AggressiveXOptBB
forall a b. Coercible a b => a -> b
coerce (ClashOpts -> Bool
opt_aggressiveXOptBB ClashOpts
opts)
    , _domainConfigurations_ :: DomainMap
_domainConfigurations_=DomainMap
emptyDomainMap
    , _usages :: UsageMap
_usages=UsageMap
forall a. Monoid a => a
mempty
    }
  hdlKind :: VerilogState -> HDL
hdlKind         = HDL -> VerilogState -> HDL
forall a b. a -> b -> a
const HDL
Verilog
  primDirs :: VerilogState -> IO [[Char]]
primDirs        = IO [[Char]] -> VerilogState -> IO [[Char]]
forall a b. a -> b -> a
const (IO [[Char]] -> VerilogState -> IO [[Char]])
-> IO [[Char]] -> VerilogState -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ do [Char]
root <- IO [Char]
primsRoot
                               [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [ [Char]
root [Char] -> [Char] -> [Char]
System.FilePath.</> [Char]
"common"
                                      , [Char]
root [Char] -> [Char] -> [Char]
System.FilePath.</> [Char]
"commonverilog"
                                      , [Char]
root [Char] -> [Char] -> [Char]
System.FilePath.</> [Char]
"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 -> [Char]
name            = [Char] -> VerilogState -> [Char]
forall a b. a -> b -> a
const [Char]
"verilog"
  extension :: VerilogState -> [Char]
extension       = [Char] -> VerilogState -> [Char]
forall a b. a -> b -> a
const [Char]
".v"

  genHDL :: ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State VerilogState) (([Char], Doc), [([Char], Doc)])
genHDL          = ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State VerilogState) (([Char], Doc), [([Char], Doc)])
genVerilog
  mkTyPackage :: Text -> [HWType] -> Ap (State VerilogState) [([Char], Doc)]
mkTyPackage Text
_ [HWType]
_ = [([Char], Doc)] -> Ap (State VerilogState) [([Char], Doc)]
forall a. a -> Ap (State VerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
  hdlType :: Usage -> HWType -> VerilogM Doc
hdlType Usage
_       = HWType -> VerilogM Doc
verilogType
  hdlHWTypeKind :: HWType -> State VerilogState HWKind
hdlHWTypeKind HWType
_ = HWKind -> State VerilogState HWKind
forall a. a -> StateT VerilogState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType -- Everything is a bitvector!
  hdlTypeErrValue :: HWType -> VerilogM Doc
hdlTypeErrValue = HWType -> VerilogM Doc
verilogTypeErrValue
  hdlTypeMark :: HWType -> VerilogM Doc
hdlTypeMark     = HWType -> VerilogM Doc
verilogTypeMark
  hdlRecSel :: HWType -> Int -> VerilogM Doc
hdlRecSel       = HWType -> Int -> VerilogM Doc
verilogRecSel
  hdlSig :: Text -> HWType -> VerilogM Doc
hdlSig Text
t HWType
ty     = VerilogM Doc -> HWType -> VerilogM Doc
sigDecl (Text -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
t) HWType
ty
  genStmt :: Bool -> State VerilogState Doc
genStmt Bool
True    = do Int
cnt <- Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: Type -> Type) 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 :: Type -> Type) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
                       if Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                          then State VerilogState Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
                          else State VerilogState Doc
"generate"
  genStmt Bool
False   = do (Int -> Identity Int) -> VerilogState -> Identity VerilogState
Lens' VerilogState Int
genDepth ((Int -> Identity Int) -> VerilogState -> Identity VerilogState)
-> Int -> State VerilogState ()
forall s (m :: Type -> Type) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= Int
1
                       Int
cnt <- Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: Type -> Type) 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
> Int
0
                          then State VerilogState Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
                          else State VerilogState Doc
"endgenerate"
  inst :: Declaration -> Ap (State VerilogState) (Maybe Doc)
inst            = Declaration -> Ap (State VerilogState) (Maybe Doc)
inst_
  expr :: Bool -> Expr -> VerilogM Doc
expr            = Bool -> Expr -> VerilogM Doc
expr_
  iwWidth :: State VerilogState Int
iwWidth         = Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  toBV :: HWType -> Text -> VerilogM Doc
toBV HWType
ty Text
e       = case HWType
ty of
    Signed Int
_ -> VerilogM Doc
"$unsigned" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e)
    HWType
_ -> Text -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e
  fromBV :: HWType -> Text -> VerilogM Doc
fromBV HWType
ty Text
e     = case HWType
ty of
    Signed Int
_ -> VerilogM Doc
"$signed" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e)
    HWType
_ -> Text -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e
  hdlSyn :: State VerilogState HdlSyn
hdlSyn          = Getting HdlSyn VerilogState HdlSyn -> State VerilogState HdlSyn
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting HdlSyn VerilogState HdlSyn
Lens' VerilogState HdlSyn
hdlsyn
  setModName :: Text -> VerilogState -> VerilogState
setModName Text
_    = VerilogState -> VerilogState
forall a. a -> a
id
  setTopName :: Identifier -> VerilogState -> VerilogState
setTopName Identifier
nm VerilogState
s = VerilogState
s {_topNm = nm}
  getTopName :: State VerilogState Identifier
getTopName      = Getting Identifier VerilogState Identifier
-> State VerilogState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VerilogState Identifier
Lens' VerilogState Identifier
topNm
  setSrcSpan :: SrcSpan -> State VerilogState ()
setSrcSpan      = ((SrcSpan -> Identity SrcSpan)
-> VerilogState -> Identity VerilogState
Lens' VerilogState SrcSpan
srcSpan .=)
  getSrcSpan :: State VerilogState SrcSpan
getSrcSpan      = Getting SrcSpan VerilogState SrcSpan -> State VerilogState SrcSpan
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting SrcSpan VerilogState SrcSpan
Lens' VerilogState SrcSpan
srcSpan
  blockDecl :: Identifier -> [Declaration] -> VerilogM Doc
blockDecl Identifier
_ [Declaration]
ds  = do
    Doc
decs <- [Declaration] -> VerilogM Doc
decls [Declaration]
ds
    if Doc -> Bool
isEmpty Doc
decs
      then [Declaration] -> VerilogM Doc
insts [Declaration]
ds
      else
        Doc -> VerilogM Doc
forall a. a -> Ap (State VerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
decs VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
        [Declaration] -> VerilogM Doc
insts [Declaration]
ds
  addIncludes :: [([Char], Doc)] -> State VerilogState ()
addIncludes [([Char], Doc)]
inc = ([([Char], Doc)] -> Identity [([Char], Doc)])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [([Char], Doc)]
includes (([([Char], Doc)] -> Identity [([Char], Doc)])
 -> VerilogState -> Identity VerilogState)
-> ([([Char], Doc)] -> [([Char], Doc)]) -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([([Char], Doc)]
inc ++)
  addLibraries :: [Text] -> State VerilogState ()
addLibraries [Text]
libs = (HashSet Text -> Identity (HashSet Text))
-> VerilogState -> Identity VerilogState
Lens' VerilogState (HashSet Text)
libraries ((HashSet Text -> Identity (HashSet Text))
 -> VerilogState -> Identity VerilogState)
-> (HashSet Text -> HashSet Text) -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (\HashSet Text
s -> (HashSet Text -> Text -> HashSet Text)
-> HashSet Text -> [Text] -> HashSet Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Text -> HashSet Text -> HashSet Text)
-> HashSet Text -> Text -> HashSet Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert) HashSet Text
s [Text]
libs)
  addImports :: [Text] -> State VerilogState ()
addImports [Text]
inps = (HashSet Text -> Identity (HashSet Text))
-> VerilogState -> Identity VerilogState
Lens' VerilogState (HashSet Text)
imports ((HashSet Text -> Identity (HashSet Text))
 -> VerilogState -> Identity VerilogState)
-> (HashSet Text -> HashSet Text) -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (\HashSet Text
s -> (HashSet Text -> Text -> HashSet Text)
-> HashSet Text -> [Text] -> HashSet Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Text -> HashSet Text -> HashSet Text)
-> HashSet Text -> Text -> HashSet Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert) HashSet Text
s [Text]
inps)
  addAndSetData :: [Char] -> State VerilogState [Char]
addAndSetData [Char]
f = do
    [([Char], [Char])]
fs <- Getting [([Char], [Char])] VerilogState [([Char], [Char])]
-> State VerilogState [([Char], [Char])]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [([Char], [Char])] VerilogState [([Char], [Char])]
Lens' VerilogState [([Char], [Char])]
dataFiles
    let ([([Char], [Char])]
fs',[Char]
f') = [([Char], [Char])] -> [Char] -> ([([Char], [Char])], [Char])
renderFilePath [([Char], [Char])]
fs [Char]
f
    ([([Char], [Char])] -> Identity [([Char], [Char])])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [([Char], [Char])]
dataFiles (([([Char], [Char])] -> Identity [([Char], [Char])])
 -> VerilogState -> Identity VerilogState)
-> [([Char], [Char])] -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [([Char], [Char])]
fs'
    [Char] -> State VerilogState [Char]
forall a. a -> StateT VerilogState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
f'
  getDataFiles :: State VerilogState [([Char], [Char])]
getDataFiles = Getting [([Char], [Char])] VerilogState [([Char], [Char])]
-> State VerilogState [([Char], [Char])]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [([Char], [Char])] VerilogState [([Char], [Char])]
Lens' VerilogState [([Char], [Char])]
dataFiles
  addMemoryDataFile :: ([Char], [Char]) -> State VerilogState ()
addMemoryDataFile ([Char], [Char])
f = ([([Char], [Char])] -> Identity [([Char], [Char])])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [([Char], [Char])]
memoryDataFiles (([([Char], [Char])] -> Identity [([Char], [Char])])
 -> VerilogState -> Identity VerilogState)
-> ([([Char], [Char])] -> [([Char], [Char])])
-> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (([Char], [Char])
f:)
  getMemoryDataFiles :: State VerilogState [([Char], [Char])]
getMemoryDataFiles = Getting [([Char], [Char])] VerilogState [([Char], [Char])]
-> State VerilogState [([Char], [Char])]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [([Char], [Char])] VerilogState [([Char], [Char])]
Lens' VerilogState [([Char], [Char])]
memoryDataFiles
  ifThenElseExpr :: VerilogState -> Bool
ifThenElseExpr VerilogState
_ = Bool
True
  aggressiveXOptBB :: State VerilogState AggressiveXOptBB
aggressiveXOptBB = Getting AggressiveXOptBB VerilogState AggressiveXOptBB
-> State VerilogState AggressiveXOptBB
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting AggressiveXOptBB VerilogState AggressiveXOptBB
Lens' VerilogState AggressiveXOptBB
aggressiveXOptBB_
  renderEnums :: State VerilogState RenderEnums
renderEnums = RenderEnums -> State VerilogState RenderEnums
forall a. a -> StateT VerilogState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Bool -> RenderEnums
RenderEnums Bool
False)
  domainConfigurations :: State VerilogState DomainMap
domainConfigurations = Getting DomainMap VerilogState DomainMap
-> State VerilogState DomainMap
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting DomainMap VerilogState DomainMap
Lens' VerilogState DomainMap
domainConfigurations_
  setDomainConfigurations :: DomainMap -> VerilogState -> VerilogState
setDomainConfigurations DomainMap
confs VerilogState
s = VerilogState
s {_domainConfigurations_ = confs}

type VerilogM a = Ap (State VerilogState) a

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

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

sigPort
  :: VerilogM Doc
  -> Maybe N.Usage
  -> Identifier
  -> HWType
  -> Maybe Expr
  -> VerilogM Doc
sigPort :: VerilogM Doc
-> Maybe Usage
-> Identifier
-> HWType
-> Maybe Expr
-> VerilogM Doc
sigPort VerilogM Doc
def Maybe Usage
mu (Identifier -> Text
Id.toText -> Text
pName) HWType
hwType Maybe Expr
iEM = do
    [Attr Text] -> VerilogM Doc -> VerilogM Doc
addAttrs (HWType -> [Attr Text]
hwTypeAttrs HWType
hwType)
      (VerilogM Doc
portType VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VerilogM Doc
verilogType HWType
hwType VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
pName VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
iE VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> VerilogM Doc
forall (m :: Type -> Type). Applicative m => HWType -> m Doc
encodingNote HWType
hwType)
  where
    portType :: VerilogM Doc
portType =
      -- See NOTE [net and variable ports]
      case Maybe Usage
mu of
        Just Usage
Cont ->
          VerilogM Doc
"output wire"

        Just Proc{} ->
          VerilogM Doc
"output reg"

        Maybe Usage
Nothing ->
          if HWType -> Bool
isBiSignalIn HWType
hwType then VerilogM Doc
"inout wire" else VerilogM Doc
def VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
"wire"

    iE :: VerilogM Doc
iE = VerilogM Doc
-> (Expr -> VerilogM Doc) -> Maybe Expr -> VerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (VerilogM Doc -> VerilogM Doc
forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m Doc -> m Doc
noEmptyInit (VerilogM Doc -> VerilogM Doc)
-> (Expr -> VerilogM Doc) -> Expr -> VerilogM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> VerilogM Doc
expr_ Bool
False) Maybe Expr
iEM

{-
NOTE [net and variable ports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In Verilog, ports are typically seen written with the default implicit net type
of wire, i.e.

  input foo,
  output bar,

which is really a shorthand for

  input wire foo,
  output wire bar,

When we use `default_nettype none however, this is no longer allowed as all
nets must be explicitly given their type. When generating code we must include
the additional word wire (the net type).

What is the benefit of this? When we have a default net type, any variable
generated which is not declared is given an implicit declaration of this
default type. This can obscure clash errors, i.e. if Clash generated

  wire foo;
  fo <= ...;

Then simulators would act as though this was written:

  wire foo;
  wire fo;
  fo <= ...;

Which should never be the desired behaviour for code generated by Clash.

One final point, Verilog allows output to also be a variable type, i.e.

  output reg foo;

If a port is an input or an inout then it can only be a net and not a variable
according to the standard, so input reg and inout reg are impossible.
-}

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

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

    inPorts :: Ap (State VerilogState) [Doc]
inPorts  = [VerilogM Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [ VerilogM Doc
-> Maybe Usage
-> Identifier
-> HWType
-> Maybe Expr
-> VerilogM Doc
sigPort VerilogM Doc
"input" Maybe Usage
forall a. Maybe a
Nothing Identifier
id_ HWType
hwType Maybe Expr
forall a. Maybe a
Nothing | (Identifier
id_, HWType
hwType) <- Component -> [(Identifier, HWType)]
inputs Component
c  ]
    outPorts :: Ap (State VerilogState) [Doc]
outPorts = do
      UsageMap
us <- Getting UsageMap VerilogState UsageMap
-> Ap (State VerilogState) UsageMap
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting UsageMap VerilogState UsageMap
Lens' VerilogState UsageMap
usages
      let useOf :: Identifier -> Usage -> Maybe Usage
useOf Identifier
i Usage
u = Identifier -> UsageMap -> Maybe Usage
lookupUsage Identifier
i UsageMap
us Maybe Usage -> Maybe Usage -> Maybe Usage
forall a. Semigroup a => a -> a -> a
<> Usage -> Maybe Usage
forall a. a -> Maybe a
Just Usage
u
      [VerilogM Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [ VerilogM Doc
-> Maybe Usage
-> Identifier
-> HWType
-> Maybe Expr
-> VerilogM Doc
sigPort VerilogM Doc
"output" (Identifier -> Usage -> Maybe Usage
useOf Identifier
id_ Usage
u) Identifier
id_ HWType
hwType Maybe Expr
iEM | (Usage
u,(Identifier
id_, HWType
hwType), Maybe Expr
iEM) <- Component -> [(Usage, (Identifier, HWType), Maybe Expr)]
outputs Component
c ]

    -- slightly more readable than 'tupled', makes the output Haskell-y-er
    commafy :: Doc -> f Doc
commafy Doc
v = (f Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
space) f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> f Doc
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
v

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

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

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

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

usageFileDoc :: Maybe N.Usage -> HWType -> VerilogM Doc
usageFileDoc :: Maybe Usage -> HWType -> VerilogM Doc
usageFileDoc Maybe Usage
_             HWType
FileType  = VerilogM Doc
"integer"
usageFileDoc (Just Proc{}) HWType
_         = VerilogM Doc
"reg"
usageFileDoc Maybe Usage
_             HWType
_         = VerilogM Doc
"wire"

verilogType :: HWType -> VerilogM Doc
verilogType :: HWType -> VerilogM Doc
verilogType HWType
t = case HWType
t of
  Signed Int
n -> VerilogM Doc
"signed" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
  Clock {} -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
  ClockN {} -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
  Reset {} -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
  Enable {} -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
  HWType
Bit      -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
  HWType
Bool     -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
  HWType
FileType -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
  Annotated [Attr Text]
_ HWType
ty -> HWType -> VerilogM Doc
verilogType HWType
ty
  BiDirectional PortDirection
_ HWType
ty -> HWType -> VerilogM Doc
verilogType HWType
ty
  HWType
_        -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)

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

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

-- | Convert a Netlist HWType to an error Verilog value for that type
verilogTypeErrValue :: HWType -> VerilogM Doc
verilogTypeErrValue :: HWType -> VerilogM Doc
verilogTypeErrValue HWType
ty = do
  Maybe (Maybe Int)
udf <- State VerilogState (Maybe (Maybe Int))
-> Ap (State VerilogState) (Maybe (Maybe Int))
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting (Maybe (Maybe Int)) VerilogState (Maybe (Maybe Int))
-> State VerilogState (Maybe (Maybe Int))
forall s (m :: Type -> Type) 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
    Maybe (Maybe Int)
Nothing       -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces VerilogM Doc
"1'bx")
    Just Maybe Int
Nothing  -> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
"'d0 /* undefined */"
    Just (Just Int
x) -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (VerilogM Doc
"1'b" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
x)) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
"/* undefined */"

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

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

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

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

decl :: Declaration -> VerilogM (Maybe Doc)
decl :: Declaration -> Ap (State VerilogState) (Maybe Doc)
decl (NetDecl' Maybe Text
noteM Identifier
id_ HWType
tyE Maybe Expr
iEM) = do
  UsageMap
us <- Getting UsageMap VerilogState UsageMap
-> Ap (State VerilogState) UsageMap
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting UsageMap VerilogState UsageMap
Lens' VerilogState UsageMap
usages
  let u :: Maybe Usage
u = Identifier -> UsageMap -> Maybe Usage
lookupUsage Identifier
id_ UsageMap
us
  Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> VerilogM Doc -> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (VerilogM Doc -> VerilogM Doc)
-> (Text -> VerilogM Doc -> VerilogM Doc)
-> Maybe Text
-> VerilogM Doc
-> VerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VerilogM Doc -> VerilogM Doc
forall a. a -> a
id Text -> VerilogM Doc -> VerilogM Doc
forall {f :: Type -> Type}.
(Monoid (f Doc), Applicative f, IsString (f Doc)) =>
Text -> f Doc -> f Doc
addNote Maybe Text
noteM ([Attr Text] -> VerilogM Doc -> VerilogM Doc
addAttrs [Attr Text]
attrs (Maybe Usage -> HWType -> VerilogM Doc
usageFileDoc Maybe Usage
u HWType
tyE VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VerilogM Doc
tyDec HWType
tyE))
  where
    tyDec :: HWType -> VerilogM Doc
tyDec HWType
ty = VerilogM Doc -> HWType -> VerilogM Doc
sigDecl (Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) HWType
ty VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
iE
    addNote :: Text -> f Doc -> f Doc
addNote Text
n = f Doc -> f Doc -> f Doc
forall a. Monoid a => a -> a -> a
mappend (f Doc
"//" f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> f Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
n f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
line)
    attrs :: [Attr Text]
attrs = [Attr Text] -> Maybe [Attr Text] -> [Attr Text]
forall a. a -> Maybe a -> a
fromMaybe [] (HWType -> [Attr Text]
hwTypeAttrs (HWType -> [Attr Text]) -> Maybe HWType -> Maybe [Attr Text]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> HWType -> Maybe HWType
forall a. a -> Maybe a
Just HWType
tyE)
    iE :: VerilogM Doc
iE    = VerilogM Doc
-> (Expr -> VerilogM Doc) -> Maybe Expr -> VerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (VerilogM Doc -> VerilogM Doc
forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m Doc -> m Doc
noEmptyInit (VerilogM Doc -> VerilogM Doc)
-> (Expr -> VerilogM Doc) -> Expr -> VerilogM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> VerilogM Doc
expr_ Bool
False) Maybe Expr
iEM

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

noEmptyInit :: (Monad m, Semigroup (m Doc)) => m Doc -> m Doc
noEmptyInit :: forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m Doc -> m Doc
noEmptyInit m Doc
d = do
  Doc
d1 <- m Doc
d
  if Doc -> Bool
isEmpty Doc
d1
     then m Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
     else (m Doc
forall (f :: Type -> Type). Applicative f => f Doc
space m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"=" m Doc -> m Doc -> m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> m Doc
d)

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

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

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

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

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

patLitCustom HWType
hwTy Literal
_
  | CustomProduct Text
_name DataRepr'
dataRepr Int
size Maybe [Text]
_maybeFieldNames [(Integer, HWType)]
_reprs <- HWType
hwTy
  , DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr =
  Int -> ConstrRepr' -> VerilogM Doc
patLitCustom' Int
size ConstrRepr'
cRepr

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

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

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

      esMod :: [(Maybe Literal, Expr)]
esMod = ((Maybe Literal, Expr) -> (Maybe Literal, Expr))
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Literal -> Maybe Literal)
-> (Maybe Literal, Expr) -> (Maybe Literal, Expr)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Literal -> Literal) -> Maybe Literal -> Maybe Literal
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (HWType -> Literal -> Literal
patMod HWType
scrutTy))) [(Maybe Literal, Expr)]
es
      esNub :: [(Maybe Literal, Expr)]
esNub = ((Maybe Literal, Expr) -> (Maybe Literal, Expr) -> Bool)
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Maybe Literal -> Maybe Literal -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Literal -> Maybe Literal -> Bool)
-> ((Maybe Literal, Expr) -> Maybe Literal)
-> (Maybe Literal, Expr)
-> (Maybe Literal, Expr)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe Literal, Expr) -> Maybe Literal
forall a b. (a, b) -> a
fst) [(Maybe Literal, Expr)]
esMod
      var :: VerilogM Doc
var   = Bool -> Expr -> VerilogM Doc
expr_ Bool
True Expr
scrut

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

-- | Turn a Netlist Declaration to a Verilog concurrent block
inst_ :: Declaration -> VerilogM (Maybe Doc)
inst_ :: Declaration -> Ap (State VerilogState) (Maybe Doc)
inst_ (TickDecl {}) = Maybe Doc -> Ap (State VerilogState) (Maybe Doc)
forall a. a -> Ap (State VerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing
inst_ (CompDecl {}) = Maybe Doc -> Ap (State VerilogState) (Maybe Doc)
forall a. a -> Ap (State VerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing
inst_ (Assignment Identifier
id_ Usage
Cont Expr
e) = (Doc -> Maybe Doc)
-> VerilogM Doc -> Ap (State VerilogState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VerilogState) a -> Ap (State VerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (VerilogM Doc -> Ap (State VerilogState) (Maybe Doc))
-> VerilogM Doc -> Ap (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  VerilogM Doc
"assign" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> VerilogM Doc
expr_ Bool
False Expr
e VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut HWType
_ [(Just (BoolLit Bool
b), Expr
l),(Maybe Literal
_,Expr
r)]) = (Doc -> Maybe Doc)
-> VerilogM Doc -> Ap (State VerilogState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VerilogState) a -> Ap (State VerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (VerilogM Doc -> Ap (State VerilogState) (Maybe Doc))
-> VerilogM Doc -> Ap (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
   VerilogM Doc
"always @(*) begin" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
   Int -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VerilogM Doc
"if" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> VerilogM Doc
expr_ Bool
True Expr
scrut) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
               (Int -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VerilogM Doc -> VerilogM Doc) -> VerilogM Doc -> VerilogM Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> VerilogM Doc
expr_ Bool
False Expr
t VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
            VerilogM Doc
"else" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
               (Int -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VerilogM Doc -> VerilogM Doc) -> VerilogM Doc -> VerilogM Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> VerilogM Doc
expr_ Bool
False Expr
f VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
   VerilogM Doc
"end"
  where
    (Expr
t,Expr
f) = if Bool
b then (Expr
l,Expr
r) else (Expr
r,Expr
l)

inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut scrutTy :: HWType
scrutTy@(CustomSP {}) [(Maybe Literal, Expr)]
es) =
  Text
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Ap (State VerilogState) (Maybe Doc)
inst_' (Identifier -> Text
Id.toText Identifier
id_) Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es

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

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

inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es) = (Doc -> Maybe Doc)
-> VerilogM Doc -> Ap (State VerilogState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VerilogState) a -> Ap (State VerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (VerilogM Doc -> Ap (State VerilogState) (Maybe Doc))
-> VerilogM Doc -> Ap (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
    VerilogM Doc
"always @(*) begin" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VerilogM Doc
"case" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> VerilogM Doc
expr_ Bool
True Expr
scrut) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                (Int -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VerilogM Doc -> VerilogM Doc) -> VerilogM Doc -> VerilogM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VerilogState) [Doc] -> VerilogM Doc)
-> Ap (State VerilogState) [Doc] -> VerilogM Doc
forall a b. (a -> b) -> a -> b
$ VerilogM Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi (Text -> [(Maybe Literal, Expr)] -> Ap (State VerilogState) [Doc]
conds (Identifier -> Text
Id.toText Identifier
id_) [(Maybe Literal, Expr)]
es)) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
              VerilogM Doc
"endcase") VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
    VerilogM Doc
"end"
  where
    conds :: IdentifierText -> [(Maybe Literal,Expr)] -> VerilogM [Doc]
    conds :: Text -> [(Maybe Literal, Expr)] -> Ap (State VerilogState) [Doc]
conds Text
_ []                = [Doc] -> Ap (State VerilogState) [Doc]
forall a. a -> Ap (State VerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds Text
i [(Maybe Literal
_,Expr
e)]           = (VerilogM Doc
"default" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
i VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> VerilogM Doc
expr_ Bool
False Expr
e) VerilogM Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State VerilogState) [Doc]
forall a. a -> Ap (State VerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds Text
i ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_)   = (VerilogM Doc
"default" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
i VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> VerilogM Doc
expr_ Bool
False Expr
e) VerilogM Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State VerilogState) [Doc]
forall a. a -> Ap (State VerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds Text
i ((Just Literal
c ,Expr
e):[(Maybe Literal, Expr)]
es') = (Maybe (HWType, Int) -> Literal -> VerilogM Doc
exprLitV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
scrutTy,HWType -> Int
conSize HWType
scrutTy)) Literal
c VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
i VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> VerilogM Doc
expr_ Bool
False Expr
e) VerilogM Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> Text -> [(Maybe Literal, Expr)] -> Ap (State VerilogState) [Doc]
conds Text
i [(Maybe Literal, Expr)]
es'

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

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

inst_ (BlackBoxD Text
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx) =
  (Doc -> Maybe Doc)
-> VerilogM Doc -> Ap (State VerilogState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VerilogState) a -> Ap (State VerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (State VerilogState Doc -> VerilogM Doc
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VerilogState (Int -> Doc) -> State VerilogState Doc
forall (f :: Type -> Type). Functor f => f (Int -> Doc) -> f Doc
column ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State VerilogState (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx)))

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

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

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

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

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

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

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

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

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

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

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

  Declaration
_ -> [Char] -> VerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char]
"seq_: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Declaration -> [Char]
forall a. Show a => a -> [Char]
show Declaration
sd)

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

-- | Range slice, can be contiguous, or split into multiple sub-ranges
data Range
  = Contiguous Int Int
  | Split [(Int,Int,Provenance)]

-- | Original index range of a split range element
data Provenance
  = Provenance Int Int

-- | Slice ranges out of a split-range element
inRange
  :: [(Int,Int)]
  -- ^ start and end indexes into the original data type
  -> (Int,Int,Provenance)
  -- ^ Element of a split range
  -> ([(Int,Int)],[(Int,Int,Provenance)])
  -- ^
  -- 1. stand and end indexes to be sliced from the rest of the split range elements
  -- 2. Subset of the current split range for the projected data type
inRange :: [(Int, Int)]
-> (Int, Int, Provenance)
-> ([(Int, Int)], [(Int, Int, Provenance)])
inRange [] (Int, Int, Provenance)
_ = ([],[])
inRange ((Int
start,Int
end):[(Int, Int)]
ses) orig :: (Int, Int, Provenance)
orig@(Int
_,Int
endRange,Provenance Int
_ Int
endProvenance) =
{-
The following explains the index calculations

== Start ==
-----------------------------------
|     2     | |    1   | |   0    |  <- split range element number
|15|14|13|12| |10| 9| 8| | 4| 3| 2|  <- split range indexes
-----------------------------------
| 9| 8| 7| 6| | 5| 4| 3| | 2| 1| 0|  <- original indexes of the data type (provenance)
-----------------------------------
                   4          1      <- `start` and `end` index that we want to slice

== split range element 2 ==
startOffset: start(4) - endProvenance(6) = -2

next start: 4
next end:   1

== split range element 1 ==
startOffset: start(4) - endProvenance(3) = 1
endOffSet  : end(1) - endProvenance(3) = -2

startRangeNew: endRange(8) + startOffSet(1) = 9
endRangeNew  : endRange(8)

startProvenanceNew: start(4) - end(1)                    = 3
endProvenanceNew  : startProvenanceNew(3)-startOffset(1) = 2

newSplitRange:
-------
|  1  |
| 9| 8| <- new split range element
-------
| 3| 2| <- index into the projected data type

next start: endProvenance(3) - 1 = 2
next end  : 1

== split range element 0 ==
startOffset: start(2) - endProvenance(0) = 2
endOffset  : end(1) - endProvenance(0)   = 1

startRangeNew: endRange(2) + startOffSet(2) = 4
endRangeNew  : endRange(2) + endOffSet(1)   = 3

startProvenanceNew: start(2) - end(1) = 1
endProvenanceNew  :                   = 0

newSplitRange:
-------
|  0  |
| 4| 3| <- new split range element
-------
| 1| 0| <- index into the projected data type
-}
  let startOffset :: Int
startOffset = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
endProvenance
      endOffset :: Int
endOffset   = Int
end   Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
endProvenance
  in
  if Int
startOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then
    let startRangeNew :: Int
startRangeNew = Int
endRange Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
startOffset
        endRangeNew :: Int
endRangeNew =
          if Int
endOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then
             Int
endRange Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
endOffset
          else
            Int
endRange

        startProvenanceNew :: Int
startProvenanceNew = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end
        endProvenanceNew :: Int
endProvenanceNew =
          if Int
endOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then
            Int
0
          else
            Int
startProvenanceNew Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startOffset

        newSplitRange :: (Int, Int, Provenance)
newSplitRange =
          ( Int
startRangeNew
          , Int
endRangeNew
          , Int -> Int -> Provenance
Provenance Int
startProvenanceNew Int
endProvenanceNew)
    in
    if Int
endOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then
      -- try to slice the next start+end in the current split range element
      ([(Int, Int, Provenance)] -> [(Int, Int, Provenance)])
-> ([(Int, Int)], [(Int, Int, Provenance)])
-> ([(Int, Int)], [(Int, Int, Provenance)])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: Type -> Type -> Type) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Int, Int, Provenance)
newSplitRange:) ([(Int, Int)]
-> (Int, Int, Provenance)
-> ([(Int, Int)], [(Int, Int, Provenance)])
inRange [(Int, Int)]
ses (Int, Int, Provenance)
orig)
    else
      -- continue the slice in the next split range element
      ((Int
endProvenanceInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
end)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[(Int, Int)]
ses,[(Int, Int, Provenance)
newSplitRange])
  else
    -- start offset beyond last bit in the element of the split range
    ((Int
start,Int
end)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[(Int, Int)]
ses,[])

-- | Create an Split range element
buildSplitRange
  :: Int
  -- ^ Offset
  -> Int
  -- ^ End index into the original data type
  -> (Int,Int)
  -- ^ start and end index for this sub-range
  -> (Int,(Int,Int,Provenance))
buildSplitRange :: Int -> Int -> (Int, Int) -> (Int, (Int, Int, Provenance))
buildSplitRange Int
offset Int
eP (Int
s,Int
e) =
  let d :: Int
d = Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
e in
  (Int
ePInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,(Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset, Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset, Int -> Int -> Provenance
Provenance (Int
ePInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) Int
eP))

-- | Select a sub-range from a range
continueWithRange
  :: [(Int,Int)]
  -- ^ Starts and ends
  -> HWType
  -- ^ Type of the projection
  -> Range
  -- ^ Range selected so far
  -> (Range, HWType)
continueWithRange :: [(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
hty Range
r = case Range
r of
  Contiguous Int
_ Int
offset -> case [(Int, Int)]
ses of
    [(Int
start,Int
end)] ->
      (Int -> Int -> Range
Contiguous (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
hty)
    [(Int, Int)]
ses1 ->
      let ses2 :: [(Int, Int, Provenance)]
ses2 = (Int, [(Int, Int, Provenance)]) -> [(Int, Int, Provenance)]
forall a b. (a, b) -> b
snd ((Int -> (Int, Int) -> (Int, (Int, Int, Provenance)))
-> Int -> [(Int, Int)] -> (Int, [(Int, Int, Provenance)])
forall (t :: Type -> Type) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR (Int -> Int -> (Int, Int) -> (Int, (Int, Int, Provenance))
buildSplitRange Int
offset) Int
0 [(Int, Int)]
ses1) in
      ([(Int, Int, Provenance)] -> Range
Split [(Int, Int, Provenance)]
ses2, HWType
hty)
  Split [(Int, Int, Provenance)]
rs -> case [[(Int, Int, Provenance)]] -> [(Int, Int, Provenance)]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat (([(Int, Int)], [[(Int, Int, Provenance)]])
-> [[(Int, Int, Provenance)]]
forall a b. (a, b) -> b
snd (([(Int, Int)]
 -> (Int, Int, Provenance)
 -> ([(Int, Int)], [(Int, Int, Provenance)]))
-> [(Int, Int)]
-> [(Int, Int, Provenance)]
-> ([(Int, Int)], [[(Int, Int, Provenance)]])
forall (t :: Type -> Type) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL [(Int, Int)]
-> (Int, Int, Provenance)
-> ([(Int, Int)], [(Int, Int, Provenance)])
inRange [(Int, Int)]
ses [(Int, Int, Provenance)]
rs)) of
    [] -> [Char] -> (Range, HWType)
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error"
    [(Int
s1,Int
e1,Provenance
_)] -> (Int -> Int -> Range
Contiguous Int
s1 Int
e1,HWType
hty)
    [(Int, Int, Provenance)]
rs1 -> ([(Int, Int, Provenance)] -> Range
Split [(Int, Int, Provenance)]
rs1,HWType
hty)

-- | Calculate the beginning and end index into a variable, to get the
-- desired field.
-- Also returns the HWType of the result.
modifier
  :: HasCallStack
  => Range
  -- ^ Range selected so far
  -> Modifier
  -> Maybe (Range,HWType)
modifier :: HasCallStack => Range -> Modifier -> Maybe (Range, HWType)
modifier Range
r (Sliced (BitVector Int
_,Int
start,Int
end)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
hty Range
r)
  where
    hty :: HWType
hty = Int -> HWType
BitVector (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)


modifier Range
r (Indexed (ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
args),Int
dcI,Int
fI)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r)
  where
    argTys :: [HWType]
argTys   = (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Text, [HWType])]
args [(Text, [HWType])] -> Int -> (Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
dcI
    argTy :: HWType
argTy    = [HWType]
argTys [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI
    argSize :: Int
argSize  = HWType -> Int
typeSize HWType
argTy
    other :: Int
other    = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    start :: Int
start    = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
other
    end :: Int
end      = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

modifier Range
r (Indexed (ty :: HWType
ty@(Product Text
_ Maybe [Text]
_ [HWType]
argTys),Int
_,Int
fI)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r)
  where
    argTy :: HWType
argTy   = [HWType]
argTys [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI
    argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
    otherSz :: Int
otherSz = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fI Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
otherSz
    end :: Int
end     = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

modifier Range
r (Indexed (ty :: HWType
ty@(Vector Int
_ HWType
argTy),Int
1,Int
0)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r)
  where
    argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
    start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    end :: Int
end     = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

modifier Range
r (Indexed (ty :: HWType
ty@(Vector Int
n HWType
argTy),Int
1,Int
1)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
0)] HWType
hty Range
r)
  where
    argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
    start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    hty :: HWType
hty     = Int -> HWType -> HWType
Vector (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy

modifier Range
r (Indexed (ty :: HWType
ty@(RTree Int
0 HWType
argTy),Int
0,Int
0)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
0)] HWType
argTy Range
r)
  where
    start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

modifier Range
r (Indexed (ty :: HWType
ty@(RTree Int
d HWType
argTy),Int
1,Int
0)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
hty Range
r)
  where
    start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    end :: Int
end     = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    hty :: HWType
hty     = Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy

modifier Range
r (Indexed (ty :: HWType
ty@(RTree Int
d HWType
argTy),Int
1,Int
1)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
0)] HWType
hty Range
r)
  where
    start :: Int
start   = (HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    hty :: HWType
hty     = Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy

-- This is a HACK for Clash.Netlist.Util.mkTopOutput
-- Vector's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
modifier Range
r (Indexed (ty :: HWType
ty@(Vector Int
_ HWType
argTy),Int
10,Int
fI)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r)
  where
    argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
    start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
fI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
argSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    end :: Int
end     = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- This is a HACK for Clash.Netlist.Util.mkTopOutput
-- RTree's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
modifier Range
r (Indexed (ty :: HWType
ty@(RTree Int
_ HWType
argTy),Int
10,Int
fI)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r)
  where
    argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
    start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
fI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
argSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    end :: Int
end     = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

modifier Range
r (Indexed (CustomSP Text
_typName DataRepr'
_dataRepr Int
_size [(ConstrRepr', Text, [HWType])]
args,Int
dcI,Int
fI)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy Range
r)
  where
    ses :: [(Int, Int)]
ses = Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI)
    (ConstrRepr' Text
_name Int
_n Integer
_mask Integer
_value [Integer]
anns, Text
_, [HWType]
argTys) = [(ConstrRepr', Text, [HWType])]
args [(ConstrRepr', Text, [HWType])]
-> Int -> (ConstrRepr', Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
dcI
    argTy :: HWType
argTy = [HWType]
argTys [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI

modifier Range
r (Indexed (CustomProduct Text
_typName DataRepr'
dataRepr Int
_size Maybe [Text]
_maybeFieldNames [(Integer, HWType)]
args,Int
_,Int
fI))
  | DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr
  , ConstrRepr' Text
_cName Int
_pos Integer
_mask Integer
_val [Integer]
fieldAnns <- ConstrRepr'
cRepr
  = let ses :: [(Int, Int)]
ses = Integer -> [(Int, Int)]
bitRanges ([Integer]
fieldAnns [Integer] -> Int -> Integer
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI) in (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy Range
r)
 where
  argTy :: HWType
argTy = ((Integer, HWType) -> HWType) -> [(Integer, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, HWType) -> HWType
forall a b. (a, b) -> b
snd [(Integer, HWType)]
args [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI

modifier Range
r (DC (ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
_),Int
_)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
ty Range
r)
  where
    start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    end :: Int
end   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty

modifier Range
r (Nested Modifier
m1 Modifier
m2) = do
  case HasCallStack => Range -> Modifier -> Maybe (Range, HWType)
Range -> Modifier -> Maybe (Range, HWType)
modifier Range
r Modifier
m1 of
    Maybe (Range, HWType)
Nothing -> HasCallStack => Range -> Modifier -> Maybe (Range, HWType)
Range -> Modifier -> Maybe (Range, HWType)
modifier Range
r Modifier
m2
    Just (Range
r1,HWType
argTy) -> case HasCallStack => Range -> Modifier -> Maybe (Range, HWType)
Range -> Modifier -> Maybe (Range, HWType)
modifier Range
r1 Modifier
m2 of
      -- In case the second modifier is `Nothing` that means we want the entire
      -- thing calculated by the first modifier
      Maybe (Range, HWType)
Nothing -> (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just (Range
r1,HWType
argTy)
      Maybe (Range, HWType)
m       -> Maybe (Range, HWType)
m

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

-- | Render a data constructor application for data constructors having a
-- custom bit representation.
customReprDataCon
  :: DataRepr'
  -- ^ Custom representation of data type
  -> ConstrRepr'
  -- ^ Custom representation of a specific constructor of @dataRepr@
  -> [(HWType, Expr)]
  -- ^ Arguments applied to constructor
  -> VerilogM Doc
customReprDataCon :: DataRepr' -> ConstrRepr' -> [(HWType, Expr)] -> VerilogM Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
constrRepr [] =
  let origins :: [BitOrigin]
origins = DataRepr' -> ConstrRepr' -> [BitOrigin]
bitOrigins DataRepr'
dataRepr ConstrRepr'
constrRepr :: [BitOrigin] in
  case [BitOrigin]
origins of
    [Lit ([Bit] -> [Bit]
bitsToBits -> [Bit]
ns)] ->
      Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int ([Bit] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Bit]
ns) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
"b" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Bit -> VerilogM Doc) -> [Bit] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Lens' VerilogState (Maybe (Maybe Int)) -> Bit -> VerilogM Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Ap (State s) Doc
bit_char (Maybe (Maybe Int) -> f (Maybe (Maybe Int)))
-> VerilogState -> f VerilogState
Lens' VerilogState (Maybe (Maybe Int))
undefValue) [Bit]
ns)
    [BitOrigin]
_ -> [Char] -> VerilogM Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error"
customReprDataCon DataRepr'
dataRepr ConstrRepr'
constrRepr [(HWType, Expr)]
args = do
  Identifier
funId <- Ap (State VerilogState) Identifier
mkConstrFunction
  State VerilogState () -> Ap (State VerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet Text -> Identity (HashSet Text))
-> VerilogState -> Identity VerilogState
Lens' VerilogState (HashSet Text)
imports ((HashSet Text -> Identity (HashSet Text))
 -> VerilogState -> Identity VerilogState)
-> (HashSet Text -> HashSet Text) -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert ([Char] -> Text
Text.pack (Text -> [Char]
TextS.unpack (Identifier -> Text
Id.toText Identifier
funId) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".inc")))
  Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
funId VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (((HWType, Expr) -> VerilogM Doc)
-> [(HWType, Expr)] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Bool -> Expr -> VerilogM Doc
expr_ Bool
False (Expr -> VerilogM Doc)
-> ((HWType, Expr) -> Expr) -> (HWType, Expr) -> VerilogM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HWType, Expr) -> Expr
forall a b. (a, b) -> b
snd) [(HWType, Expr)]
nzArgs)
 where
  nzArgs :: [(HWType, Expr)]
nzArgs = ((HWType, Expr) -> Bool) -> [(HWType, Expr)] -> [(HWType, Expr)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0) (Int -> Bool) -> ((HWType, Expr) -> Int) -> (HWType, Expr) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Int
typeSize (HWType -> Int)
-> ((HWType, Expr) -> HWType) -> (HWType, Expr) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HWType, Expr) -> HWType
forall a b. (a, b) -> a
fst) [(HWType, Expr)]
args

  mkConstrFunction :: Ap (State VerilogState) Identifier
  mkConstrFunction :: Ap (State VerilogState) Identifier
mkConstrFunction = Text
-> Lens' VerilogState (HashMap Text Identifier)
-> Ap (State VerilogState) Identifier
-> Ap (State VerilogState) Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (ConstrRepr' -> Text
crName ConstrRepr'
constrRepr) (HashMap Text Identifier -> f (HashMap Text Identifier))
-> VerilogState -> f VerilogState
Lens' VerilogState (HashMap Text Identifier)
customConstrs (Ap (State VerilogState) Identifier
 -> Ap (State VerilogState) Identifier)
-> Ap (State VerilogState) Identifier
-> Ap (State VerilogState) Identifier
forall a b. (a -> b) -> a -> b
$ do
    let size :: Int
size    = DataRepr' -> Int
drSize DataRepr'
dataRepr
        aTys :: [HWType]
aTys    = ((HWType, Expr) -> HWType) -> [(HWType, Expr)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (HWType, Expr) -> HWType
forall a b. (a, b) -> a
fst [(HWType, Expr)]
args
        origins :: [BitOrigin]
origins = DataRepr' -> ConstrRepr' -> [BitOrigin]
bitOrigins DataRepr'
dataRepr ConstrRepr'
constrRepr :: [BitOrigin]
    let mkId :: Text -> m Identifier
mkId Text
nm = Text -> m Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Text -> m Identifier
Id.makeBasic Text
nm
    [Identifier]
ids <- (Int -> Ap (State VerilogState) Identifier)
-> [Int] -> Ap (State VerilogState) [Identifier]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\Int
n -> Text -> Ap (State VerilogState) Identifier
forall {m :: Type -> Type}.
IdentifierSetMonad m =>
Text -> m Identifier
mkId ([Char] -> Text
TextS.pack (Char
'v'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n))) [Int
1..[(HWType, Expr)] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [(HWType, Expr)]
args]
    Identifier
fId <- Text -> Ap (State VerilogState) Identifier
forall {m :: Type -> Type}.
IdentifierSetMonad m =>
Text -> m Identifier
mkId (ConstrRepr' -> Text
crName ConstrRepr'
constrRepr)
    let fInps :: [VerilogM Doc]
fInps =
          [ case HWType -> Int
typeSize HWType
t of
              Int
0 -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
              Int
1 -> VerilogM Doc
"input" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
i VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
              Int
n -> VerilogM Doc
"input" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                               Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
i VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
          | (Identifier
i,HWType
t) <- [Identifier] -> [HWType] -> [(Identifier, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Identifier]
ids [HWType]
aTys
          ]

    let range' :: BitOrigin -> VerilogM Doc
range' (Lit ([Bit] -> [Bit]
bitsToBits -> [Bit]
ns)) =
          Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int ([Bit] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Bit]
ns) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
"b" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Bit -> VerilogM Doc) -> [Bit] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Lens' VerilogState (Maybe (Maybe Int)) -> Bit -> VerilogM Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Ap (State s) Doc
bit_char (Maybe (Maybe Int) -> f (Maybe (Maybe Int)))
-> VerilogState -> f VerilogState
Lens' VerilogState (Maybe (Maybe Int))
undefValue) [Bit]
ns)
        range' (Field Int
n Int
start Int
end) =
          let v :: Identifier
v   = [Identifier]
ids [Identifier] -> Int -> Identifier
forall a. HasCallStack => [a] -> Int -> a
!! Int
n
              aTy :: HWType
aTy = [HWType]
aTys [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
n
          in case HWType -> Int
typeSize HWType
aTy of
               Int
0 -> [Char] -> VerilogM Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error"
               Int
1 -> if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
end Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
                      Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
v
                    else
                      [Char] -> VerilogM Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error"
               Int
_ -> Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
v VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)

    let val :: VerilogM Doc
val = case [BitOrigin]
origins of
                []  -> [Char] -> VerilogM Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error"
                [BitOrigin
r] -> BitOrigin -> VerilogM Doc
range' BitOrigin
r
                [BitOrigin]
rs  -> Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((BitOrigin -> VerilogM Doc)
-> [BitOrigin] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM BitOrigin -> VerilogM Doc
range' [BitOrigin]
rs)

    let oSz :: VerilogM Doc
oSz = case Int
size of
                Int
0 -> [Char] -> VerilogM Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error"
                Int
1 -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
                Int
n -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)

    Doc
funDoc <-
      VerilogM Doc
"function" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
oSz VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
fId VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ([VerilogM Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [VerilogM Doc]
fInps) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      VerilogM Doc
"begin" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
fId VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
"=" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VerilogM Doc
val VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      VerilogM Doc
"end" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      VerilogM Doc
"endfunction"
    State VerilogState () -> Ap (State VerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (([([Char], Doc)] -> Identity [([Char], Doc)])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [([Char], Doc)]
includes (([([Char], Doc)] -> Identity [([Char], Doc)])
 -> VerilogState -> Identity VerilogState)
-> ([([Char], Doc)] -> [([Char], Doc)]) -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Text -> [Char]
TextS.unpack (Identifier -> Text
Id.toText Identifier
fId) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".inc",Doc
funDoc):))
    Identifier -> Ap (State VerilogState) Identifier
forall a. a -> Ap (State VerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
fId

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

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

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

expr_ Bool
_ (Identifier Identifier
d_ (Just (Indexed (CustomProduct Text
_id DataRepr'
dataRepr Int
_size Maybe [Text]
_maybeFieldNames [(Integer, HWType)]
tys, Int
dcI, Int
fI))))
  | DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr
  , ConstrRepr' Text
_cName Int
_pos Integer
_mask Integer
_val [Integer]
anns <- ConstrRepr'
cRepr =
  let ranges :: [VerilogM Doc]
ranges = ((Int, Int) -> VerilogM Doc) -> [(Int, Int)] -> [VerilogM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> VerilogM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), Applicative f, IsString (f Doc)) =>
(Int, Int) -> f Doc
range' (Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI)) in
  case HWType
fieldTy of
    Void {} -> [Char] -> VerilogM Doc
forall a. HasCallStack => [Char] -> a
error (DataRepr' -> Int -> Int -> [Char]
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
    HWType
_       -> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (VerilogM Doc -> VerilogM Doc) -> VerilogM Doc -> VerilogM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VerilogState) [Doc] -> VerilogM Doc)
-> Ap (State VerilogState) [Doc] -> VerilogM Doc
forall a b. (a -> b) -> a -> b
$ VerilogM Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VerilogM Doc
", " (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc])
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [VerilogM Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [VerilogM Doc]
ranges
 where
  (Integer
_fieldAnn, HWType
fieldTy) = [Char] -> [(Integer, HWType)] -> Int -> (Integer, HWType)
forall a. HasCallStack => [Char] -> [a] -> Int -> a
indexNote ($(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"panic") [(Integer, HWType)]
tys Int
fI
  range' :: (Int, Int) -> f Doc
range' (Int
start, Int
end) = Identifier -> f Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
d_ f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
":" f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)

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

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

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

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

expr_ Bool
_ (Identifier Identifier
id_ (Just Modifier
m)) = case HasCallStack => Range -> Modifier -> Maybe (Range, HWType)
Range -> Modifier -> Maybe (Range, HWType)
modifier (Int -> Int -> Range
Contiguous Int
0 Int
0) Modifier
m of
  Maybe (Range, HWType)
Nothing -> Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_
  Just (Contiguous Int
start Int
end,HWType
resTy) -> case HWType
resTy of
    Signed Int
_ -> VerilogM Doc
"$signed" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Int -> VerilogM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), Applicative f) =>
Int -> Int -> f Doc
slice Int
start Int
end)
    HWType
_        -> Int -> Int -> VerilogM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), Applicative f) =>
Int -> Int -> f Doc
slice Int
start Int
end
  Just (Split [(Int, Int, Provenance)]
rs,HWType
resTy) ->
    let rs1 :: VerilogM Doc
rs1 = Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces (((Int, Int, Provenance) -> VerilogM Doc)
-> [(Int, Int, Provenance)] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\(Int
start,Int
end,Provenance
_) -> Int -> Int -> VerilogM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), Applicative f) =>
Int -> Int -> f Doc
slice Int
start Int
end) [(Int, Int, Provenance)]
rs) in
    case HWType
resTy of
      Signed Int
_ -> VerilogM Doc
"$signed" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VerilogM Doc
rs1
      HWType
_ -> VerilogM Doc
rs1

 where
  slice :: Int -> Int -> f Doc
slice Int
s Int
e = Identifier -> f Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
s f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
e)

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

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

expr_ Bool
_ (DataCon (Vector Int
1 HWType
_) Modifier
_ [Expr
e]) = Bool -> Expr -> VerilogM Doc
expr_ Bool
False Expr
e
expr_ Bool
_ e :: Expr
e@(DataCon (Vector Int
_ HWType
_) Modifier
_ es :: [Expr]
es@[Expr
_,Expr
_]) =
    Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces (Ap (State VerilogState) [Doc] -> VerilogM Doc)
-> Ap (State VerilogState) [Doc] -> VerilogM Doc
forall a b. (a -> b) -> a -> b
$ (Expr -> VerilogM Doc) -> [Expr] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Bool -> Expr -> VerilogM Doc
expr_ Bool
False) ([Expr] -> Ap (State VerilogState) [Doc])
-> [Expr] -> Ap (State VerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Expr] -> Maybe [Expr] -> [Expr]
forall a. a -> Maybe a -> a
fromMaybe [Expr]
es (Maybe [Expr] -> [Expr]) -> Maybe [Expr] -> [Expr]
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe [Expr]
vectorChain Expr
e

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

expr_ Bool
_ (DataCon (RTree Int
0 HWType
_) Modifier
_ [Expr
e]) = Bool -> Expr -> VerilogM Doc
expr_ Bool
False Expr
e
expr_ Bool
_ e :: Expr
e@(DataCon (RTree Int
_ HWType
_) Modifier
_ es :: [Expr]
es@[Expr
_,Expr
_]) =
    Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces (Ap (State VerilogState) [Doc] -> VerilogM Doc)
-> Ap (State VerilogState) [Doc] -> VerilogM Doc
forall a b. (a -> b) -> a -> b
$ (Expr -> VerilogM Doc) -> [Expr] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Bool -> Expr -> VerilogM Doc
expr_ Bool
False) ([Expr] -> Ap (State VerilogState) [Doc])
-> [Expr] -> Ap (State VerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Expr] -> Maybe [Expr] -> [Expr]
forall a. a -> Maybe a -> a
fromMaybe [Expr]
es (Maybe [Expr] -> [Expr]) -> Maybe [Expr] -> [Expr]
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe [Expr]
rtreeChain Expr
e

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

expr_ Bool
_ (DataCon ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) = VerilogM Doc
assignExpr
  where
    argTys :: [HWType]
argTys     = (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Text, [HWType])]
args [(Text, [HWType])] -> Int -> (Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
    dcSize :: Int
dcSize     = HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ((HWType -> Int) -> [HWType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Int
typeSize [HWType]
argTys)
    dcExpr :: VerilogM Doc
dcExpr     = Bool -> Expr -> VerilogM Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
    argExprs :: [VerilogM Doc]
argExprs   = (Expr -> VerilogM Doc) -> [Expr] -> [VerilogM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> VerilogM Doc
expr_ Bool
False) [Expr]
es
    extraArg :: [VerilogM Doc]
extraArg   = case HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dcSize of
                   Int
0 -> []
                   Int
n -> [Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
"'b" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Lens' VerilogState (Maybe (Maybe Int)) -> [Bit] -> VerilogM Doc
forall s. Lens' s (Maybe (Maybe Int)) -> [Bit] -> Ap (State s) Doc
bits (Maybe (Maybe Int) -> f (Maybe (Maybe Int)))
-> VerilogState -> f VerilogState
Lens' VerilogState (Maybe (Maybe Int))
undefValue (Int -> Bit -> [Bit]
forall a. Int -> a -> [a]
replicate Int
n Bit
U)]
    assignExpr :: VerilogM Doc
assignExpr = VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VerilogState) [Doc] -> VerilogM Doc)
-> Ap (State VerilogState) [Doc] -> VerilogM Doc
forall a b. (a -> b) -> a -> b
$ VerilogM Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc])
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [VerilogM Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence (VerilogM Doc
dcExprVerilogM Doc -> [VerilogM Doc] -> [VerilogM Doc]
forall a. a -> [a] -> [a]
:[VerilogM Doc]
argExprs [VerilogM Doc] -> [VerilogM Doc] -> [VerilogM Doc]
forall a. [a] -> [a] -> [a]
++ [VerilogM Doc]
extraArg))

expr_ Bool
_ (DataCon ty :: HWType
ty@(Sum Text
_ [Text]
_) (DC (HWType
_,Int
i)) []) = Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
"'d" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i

expr_ Bool
_ (DataCon ty :: HWType
ty@(CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
tys) (DC (HWType
_,Int
i)) []) =
  let (ConstrRepr' Text
_ Int
_ Integer
_ Integer
value [Integer]
_) = (ConstrRepr', Text) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Text) -> ConstrRepr')
-> (ConstrRepr', Text) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Text)]
tys [(ConstrRepr', Text)] -> Int -> (ConstrRepr', Text)
forall a. HasCallStack => [a] -> Int -> a
!! Int
i in
  Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
"d" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
value)
expr_ Bool
_ (DataCon (CustomSP Text
_name DataRepr'
dataRepr Int
_size [(ConstrRepr', Text, [HWType])]
constrs) (DC (HWType
_,Int
constrNr)) [Expr]
es) =
  let (ConstrRepr'
cRepr, Text
_, [HWType]
argTys) = [(ConstrRepr', Text, [HWType])]
constrs [(ConstrRepr', Text, [HWType])]
-> Int -> (ConstrRepr', Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
constrNr in
  DataRepr' -> ConstrRepr' -> [(HWType, Expr)] -> VerilogM Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HWType]
argTys [Expr]
es)
expr_ Bool
_ (DataCon (CustomProduct Text
_ DataRepr'
dataRepr Int
_size Maybe [Text]
_labels [(Integer, HWType)]
tys) Modifier
_ [Expr]
es) |
  DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr =
  DataRepr' -> ConstrRepr' -> [(HWType, Expr)] -> VerilogM Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Integer, HWType) -> HWType) -> [(Integer, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, HWType) -> HWType
forall a b. (a, b) -> b
snd [(Integer, HWType)]
tys) [Expr]
es)
expr_ Bool
_ (DataCon (Product {}) Modifier
_ [Expr]
es) = Ap (State VerilogState) [Doc] -> VerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> VerilogM Doc) -> [Expr] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Bool -> Expr -> VerilogM Doc
expr_ Bool
False) [Expr]
es)

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

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

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Index.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Lens' VerilogState (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> VerilogM Doc
forall s.
Lens' s (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Ap (State s) Doc
exprLit (Maybe (Maybe Int) -> f (Maybe (Maybe Int)))
-> VerilogState -> f VerilogState
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_ Bool
b (BlackBoxE Text
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx Bool
b') = do
  Bool -> VerilogM Doc -> VerilogM Doc
forall (m :: Type -> Type). Monad m => Bool -> m Doc -> m Doc
parenIf (Bool
b Bool -> Bool -> Bool
|| Bool
b') (State VerilogState Doc -> VerilogM Doc
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State VerilogState (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx State VerilogState (Int -> Doc)
-> State VerilogState Int -> State VerilogState Doc
forall a b.
State VerilogState (a -> b)
-> State VerilogState a -> State VerilogState b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Int -> State VerilogState Int
forall a. a -> StateT VerilogState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0))

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

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

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

expr_ Bool
_ (DataTag hty :: HWType
hty@(SP Text
_ [(Text, [HWType])]
_) (Right Identifier
id_)) = VerilogM Doc
"$unsigned" VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens
                                               (Identifier -> VerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc -> VerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets
                                               (Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> VerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VerilogM Doc -> VerilogM Doc -> VerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
  where
    start :: Int
start = HWType -> Int
typeSize HWType
hty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    end :: Int
end   = HWType -> Int
typeSize HWType
hty Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
hty

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

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

expr_ Bool
b (ToBv Maybe Identifier
_ HWType
_ Expr
e) = Bool -> Expr -> VerilogM Doc
expr_ Bool
b Expr
e
expr_ Bool
b (FromBv Maybe Identifier
_ HWType
_ Expr
e) = Bool -> Expr -> VerilogM Doc
expr_ Bool
b Expr
e

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

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

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

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

rtreeChain :: Expr -> Maybe [Expr]
rtreeChain :: Expr -> Maybe [Expr]
rtreeChain (DataCon (RTree Int
0 HWType
_) Modifier
_ [Expr
e])     = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just [Expr
e]
rtreeChain (DataCon (RTree Int
_ HWType
_) Modifier
_ [Expr
e1,Expr
e2]) = Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e1 Maybe Expr -> Maybe [Expr] -> Maybe [Expr]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> Expr -> Maybe [Expr]
rtreeChain Expr
e2
rtreeChain Expr
_                               = Maybe [Expr]
forall a. Maybe a
Nothing

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

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

exprLit Lens' s (Maybe (Maybe Int))
k (Just (HWType
hty,Int
sz)) (NumLit Integer
i) = case HWType
hty of
  Unsigned Int
_
   | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     -> Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"-" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
sz Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"'d" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Integer -> f Doc
integer (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
   | Bool
otherwise -> Int -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
sz Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"'d" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Integer -> f Doc
integer Integer
i
  Index Integer
_ -> Int -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
hty) Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"'d" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Integer -> f Doc
integer Integer
i
  Signed Int
_
   | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     -> Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"-" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
sz Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"'sd" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Integer -> f Doc
integer (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
   | Bool
otherwise -> Int -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
sz Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"'sd" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Integer -> f Doc
integer Integer
i
  HWType
_ -> Int -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
sz Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"'b" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State s) Doc
blit
  where
    blit :: Ap (State s) Doc
blit = Lens' s (Maybe (Maybe Int)) -> [Bit] -> Ap (State s) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> [Bit] -> Ap (State s) Doc
bits (Maybe (Maybe Int) -> f (Maybe (Maybe Int))) -> s -> f s
Lens' s (Maybe (Maybe Int))
k (Int -> Integer -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz Integer
i)
exprLit Lens' s (Maybe (Maybe Int))
k (Just (HWType
_,Int
sz)) (BitVecLit Integer
m Integer
i) = Int -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
sz Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"'b" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State s) Doc
bvlit
  where
    bvlit :: Ap (State s) Doc
bvlit = Lens' s (Maybe (Maybe Int)) -> [Bit] -> Ap (State s) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> [Bit] -> Ap (State s) Doc
bits (Maybe (Maybe Int) -> f (Maybe (Maybe Int))) -> s -> f s
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 Lens' s (Maybe (Maybe Int))
_ Maybe (HWType, Int)
_             (BoolLit Bool
t)   = Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Ap (State s) Doc) -> Text -> Ap (State s) Doc
forall a b. (a -> b) -> a -> b
$ if Bool
t then Text
"1'b1" else Text
"1'b0"
exprLit Lens' s (Maybe (Maybe Int))
k Maybe (HWType, Int)
_             (BitLit Bit
b)    = Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"1'b" Ap (State s) Doc -> Ap (State s) Doc -> Ap (State s) Doc
forall a. Semigroup a => a -> a -> a
<> Lens' s (Maybe (Maybe Int)) -> Bit -> Ap (State s) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Ap (State s) Doc
bit_char (Maybe (Maybe Int) -> f (Maybe (Maybe Int))) -> s -> f s
Lens' s (Maybe (Maybe Int))
k Bit
b
exprLit Lens' s (Maybe (Maybe Int))
_ Maybe (HWType, Int)
_             (StringLit [Char]
s) = Text -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Ap (State s) Doc)
-> ([Char] -> Text) -> [Char] -> Ap (State s) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> Ap (State s) Doc) -> [Char] -> Ap (State s) Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s
exprLit Lens' s (Maybe (Maybe Int))
_ Maybe (HWType, Int)
_             Literal
l             = [Char] -> Ap (State s) Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> Ap (State s) Doc) -> [Char] -> Ap (State s) Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"exprLit: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Literal -> [Char]
forall a. Show a => a -> [Char]
show Literal
l

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

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


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

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

bit_char :: Lens' s (Maybe (Maybe Int)) -> Bit -> Ap (State s) Doc
bit_char :: forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Ap (State s) Doc
bit_char Lens' s (Maybe (Maybe Int))
k Bit
b = do
  Maybe (Maybe Int)
udf <- State s (Maybe (Maybe Int)) -> Ap (State s) (Maybe (Maybe Int))
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting (Maybe (Maybe Int)) s (Maybe (Maybe Int))
-> State s (Maybe (Maybe Int))
forall s (m :: Type -> Type) 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 Maybe Int
Nothing,Bit
U)  -> Char -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'0'
    (Just (Just Int
i),Bit
U) -> Int -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i
    (Maybe (Maybe Int), Bit)
_                 -> Char -> Ap (State s) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char (Bit -> Char
bit_char' Bit
b)

dcToExpr :: HWType -> Int -> Expr
dcToExpr :: HWType -> Int -> Expr
dcToExpr HWType
ty Int
i = Maybe (HWType, Int) -> Literal -> Expr
Literal ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
ty,HWType -> Int
conSize HWType
ty)) (Integer -> Literal
NumLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i))

listBraces :: Monad m => m [Doc] -> m Doc
listBraces :: forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces = m Doc -> m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (m Doc -> m Doc) -> (m [Doc] -> m Doc) -> m [Doc] -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Doc -> m Doc -> m Doc -> m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f Doc
enclose m Doc
forall (f :: Type -> Type). Applicative f => f Doc
lbrace m Doc
forall (f :: Type -> Type). Applicative f => f Doc
rbrace (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
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hsep (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]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate (m Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma m Doc -> m Doc -> m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
softline)

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

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

encodingNote :: Applicative m => HWType -> m Doc
encodingNote :: forall (m :: Type -> Type). Applicative m => HWType -> m Doc
encodingNote (Clock Text
_) = Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
" // clock"
encodingNote (ClockN Text
_) = Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
" // clock (neg phase)"
encodingNote (Reset Text
_) = Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
" // reset"
encodingNote (Enable Text
_) = Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
" // enable"
encodingNote (Annotated [Attr Text]
_ HWType
t) = HWType -> m Doc
forall (m :: Type -> Type). Applicative m => HWType -> m Doc
encodingNote HWType
t
encodingNote HWType
_         = m Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc