{-# 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
, 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)
data VerilogState =
VerilogState
{ VerilogState -> Int
_genDepth :: Int
, 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)]
, VerilogState -> [([Char], [Char])]
_memoryDataFiles:: [(String,String)]
, VerilogState -> HashMap Text Identifier
_customConstrs :: HashMap TextS.Text Identifier
, VerilogState -> Int
_intWidth :: Int
, 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
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
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
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 =
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
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 ]
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
<>
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
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
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)
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')
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
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
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 ->
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 ->
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
data Range
= Contiguous Int Int
| Split [(Int,Int,Provenance)]
data Provenance
= Provenance Int Int
inRange
:: [(Int,Int)]
-> (Int,Int,Provenance)
-> ([(Int,Int)],[(Int,Int,Provenance)])
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) =
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
([(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
((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
((Int
start,Int
end)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[(Int, Int)]
ses,[])
buildSplitRange
:: Int
-> Int
-> (Int,Int)
-> (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))
continueWithRange
:: [(Int,Int)]
-> HWType
-> Range
-> (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)
modifier
:: HasCallStack
=> Range
-> 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
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
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
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
customReprDataCon
:: DataRepr'
-> ConstrRepr'
-> [(HWType, Expr)]
-> 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
expr_ :: Bool
-> Expr
-> 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)
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_
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_
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)
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)
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