{-# 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 -> [(String, Doc)]
_includes :: [(String,Doc)]
, VerilogState -> HashSet Text
_imports :: HashSet Text.Text
, VerilogState -> HashSet Text
_libraries :: HashSet Text.Text
, VerilogState -> [(String, String)]
_dataFiles :: [(String,FilePath)]
, VerilogState -> [(String, String)]
_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 :: (IdentifierSet -> f IdentifierSet)
-> VerilogState -> f VerilogState
identifierSet = (IdentifierSet -> f IdentifierSet)
-> VerilogState -> f VerilogState
Lens' VerilogState IdentifierSet
idSeen
instance HasUsageMap VerilogState where
usageMap :: (UsageMap -> f UsageMap) -> VerilogState -> f VerilogState
usageMap = (UsageMap -> f UsageMap) -> VerilogState -> f VerilogState
Lens' VerilogState UsageMap
usages
instance Backend VerilogState where
initBackend :: ClashOpts -> VerilogState
initBackend ClashOpts
opts = VerilogState :: Int
-> IdentifierSet
-> Identifier
-> SrcSpan
-> [(String, Doc)]
-> HashSet Text
-> HashSet Text
-> [(String, String)]
-> [(String, String)]
-> HashMap Text Identifier
-> Int
-> HdlSyn
-> Maybe (Maybe Int)
-> AggressiveXOptBB
-> DomainMap
-> UsageMap
-> VerilogState
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 :: [(String, 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 :: [(String, String)]
_dataFiles=[]
, _memoryDataFiles :: [(String, String)]
_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
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 [String]
primDirs = IO [String] -> VerilogState -> IO [String]
forall a b. a -> b -> a
const (IO [String] -> VerilogState -> IO [String])
-> IO [String] -> VerilogState -> IO [String]
forall a b. (a -> b) -> a -> b
$ do String
root <- IO String
primsRoot
[String] -> IO [String]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [ String
root String -> String -> String
System.FilePath.</> String
"common"
, String
root String -> String -> String
System.FilePath.</> String
"commonverilog"
, String
root String -> String -> String
System.FilePath.</> String
"verilog"
]
extractTypes :: VerilogState -> HashSet HWType
extractTypes = HashSet HWType -> VerilogState -> HashSet HWType
forall a b. a -> b -> a
const HashSet HWType
forall a. HashSet a
HashSet.empty
name :: VerilogState -> String
name = String -> VerilogState -> String
forall a b. a -> b -> a
const String
"verilog"
extension :: VerilogState -> String
extension = String -> VerilogState -> String
forall a b. a -> b -> a
const String
".v"
genHDL :: ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State VerilogState) ((String, Doc), [(String, Doc)])
genHDL = ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State VerilogState) ((String, Doc), [(String, Doc)])
genVerilog
mkTyPackage :: Text -> [HWType] -> Ap (State VerilogState) [(String, Doc)]
mkTyPackage Text
_ [HWType]
_ = [(String, Doc)] -> Ap (State VerilogState) [(String, Doc)]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
hdlType :: Usage -> HWType -> Ap (State VerilogState) Doc
hdlType Usage
_ = HWType -> Ap (State VerilogState) Doc
verilogType
hdlHWTypeKind :: HWType -> State VerilogState HWKind
hdlHWTypeKind HWType
_ = HWKind -> State VerilogState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
hdlTypeErrValue :: HWType -> Ap (State VerilogState) Doc
hdlTypeErrValue = HWType -> Ap (State VerilogState) Doc
verilogTypeErrValue
hdlTypeMark :: HWType -> Ap (State VerilogState) Doc
hdlTypeMark = HWType -> Ap (State VerilogState) Doc
verilogTypeMark
hdlRecSel :: HWType -> Int -> Ap (State VerilogState) Doc
hdlRecSel = HWType -> Int -> Ap (State VerilogState) Doc
verilogRecSel
hdlSig :: Text -> HWType -> Ap (State VerilogState) Doc
hdlSig Text
t HWType
ty = Ap (State VerilogState) Doc
-> HWType -> Ap (State VerilogState) Doc
sigDecl (Text -> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
expr = Bool -> Expr -> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
toBV HWType
ty Text
e = case HWType
ty of
Signed Int
_ -> Ap (State VerilogState) Doc
"$unsigned" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e)
HWType
_ -> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e
fromBV :: HWType -> Text -> Ap (State VerilogState) Doc
fromBV HWType
ty Text
e = case HWType
ty of
Signed Int
_ -> Ap (State VerilogState) Doc
"$signed" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e)
HWType
_ -> Text -> Ap (State VerilogState) 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 :: Identifier
_topNm = Identifier
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 ((SrcSpan -> Identity SrcSpan)
-> VerilogState -> Identity VerilogState)
-> SrcSpan -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)
getSrcSpan :: State VerilogState SrcSpan
getSrcSpan = Getting SrcSpan VerilogState SrcSpan -> State VerilogState SrcSpan
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting SrcSpan VerilogState SrcSpan
Lens' VerilogState SrcSpan
srcSpan
blockDecl :: Identifier -> [Declaration] -> Ap (State VerilogState) Doc
blockDecl Identifier
_ [Declaration]
ds = do
Doc
decs <- [Declaration] -> Ap (State VerilogState) Doc
decls [Declaration]
ds
if Doc -> Bool
isEmpty Doc
decs
then [Declaration] -> Ap (State VerilogState) Doc
insts [Declaration]
ds
else
Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
decs Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
[Declaration] -> Ap (State VerilogState) Doc
insts [Declaration]
ds
addIncludes :: [(String, Doc)] -> State VerilogState ()
addIncludes [(String, Doc)]
inc = ([(String, Doc)] -> Identity [(String, Doc)])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [(String, Doc)]
includes (([(String, Doc)] -> Identity [(String, Doc)])
-> VerilogState -> Identity VerilogState)
-> ([(String, Doc)] -> [(String, Doc)]) -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([(String, Doc)]
inc [(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
forall a. [a] -> [a] -> [a]
++)
addLibraries :: [Text] -> State 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 (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 (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 :: String -> State VerilogState String
addAndSetData String
f = do
[(String, String)]
fs <- Getting [(String, String)] VerilogState [(String, String)]
-> State VerilogState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] VerilogState [(String, String)]
Lens' VerilogState [(String, String)]
dataFiles
let ([(String, String)]
fs',String
f') = [(String, String)] -> String -> ([(String, String)], String)
renderFilePath [(String, String)]
fs String
f
([(String, String)] -> Identity [(String, String)])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [(String, String)]
dataFiles (([(String, String)] -> Identity [(String, String)])
-> VerilogState -> Identity VerilogState)
-> [(String, String)] -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(String, String)]
fs'
String -> State VerilogState String
forall (m :: Type -> Type) a. Monad m => a -> m a
return String
f'
getDataFiles :: State VerilogState [(String, String)]
getDataFiles = Getting [(String, String)] VerilogState [(String, String)]
-> State VerilogState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] VerilogState [(String, String)]
Lens' VerilogState [(String, String)]
dataFiles
addMemoryDataFile :: (String, String) -> State VerilogState ()
addMemoryDataFile (String, String)
f = ([(String, String)] -> Identity [(String, String)])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [(String, String)]
memoryDataFiles (([(String, String)] -> Identity [(String, String)])
-> VerilogState -> Identity VerilogState)
-> ([(String, String)] -> [(String, String)])
-> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String, String)
f(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:)
getMemoryDataFiles :: State VerilogState [(String, String)]
getMemoryDataFiles = Getting [(String, String)] VerilogState [(String, String)]
-> State VerilogState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] VerilogState [(String, String)]
Lens' VerilogState [(String, String)]
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 (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_ :: DomainMap
_domainConfigurations_ = DomainMap
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) ((String, Doc), [(String, 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 <- Ap (State VerilogState) Doc
commentHeader Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
nettype Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
timescale Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Component -> Ap (State VerilogState) Doc
module_ Component
c
[(String, Doc)]
incs <- State VerilogState [(String, Doc)]
-> Ap (State VerilogState) [(String, Doc)]
forall k (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VerilogState [(String, Doc)]
-> Ap (State VerilogState) [(String, Doc)])
-> State VerilogState [(String, Doc)]
-> Ap (State VerilogState) [(String, Doc)]
forall a b. (a -> b) -> a -> b
$ Getting [(String, Doc)] VerilogState [(String, Doc)]
-> State VerilogState [(String, Doc)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, Doc)] VerilogState [(String, Doc)]
Lens' VerilogState [(String, Doc)]
includes
((String, Doc), [(String, Doc)])
-> Ap (State VerilogState) ((String, Doc), [(String, Doc)])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((Text -> String
TextS.unpack (Identifier -> Text
Id.toText Identifier
cName), Doc
v), [(String, Doc)]
incs)
where
cName :: Identifier
cName = Component -> Identifier
componentName Component
c
commentHeader :: Ap (State VerilogState) Doc
commentHeader
= Ap (State VerilogState) Doc
"/* AUTOMATICALLY GENERATED VERILOG-2001 SOURCE CODE."
Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"** GENERATED BY CLASH " Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (String -> Text
Text.pack String
clashVer) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
". DO NOT MODIFY."
Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"*/"
nettype :: Ap (State VerilogState) Doc
nettype = Ap (State VerilogState) Doc
"`default_nettype none"
timescale :: Ap (State VerilogState) Doc
timescale = Ap (State VerilogState) Doc
"`timescale 100fs/" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (String -> Text
Text.pack String
precision)
precision :: String
precision = Period -> String
periodToString (ClashOpts -> Period
opt_timescalePrecision ClashOpts
opts)
sigPort
:: VerilogM Doc
-> Maybe N.Usage
-> Identifier
-> HWType
-> Maybe Expr
-> VerilogM Doc
sigPort :: Ap (State VerilogState) Doc
-> Maybe Usage
-> Identifier
-> HWType
-> Maybe Expr
-> Ap (State VerilogState) Doc
sigPort Ap (State VerilogState) Doc
def Maybe Usage
mu (Identifier -> Text
Id.toText -> Text
pName) HWType
hwType Maybe Expr
iEM = do
[Attr Text]
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
addAttrs (HWType -> [Attr Text]
hwTypeAttrs HWType
hwType)
(Ap (State VerilogState) Doc
portType Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Ap (State VerilogState) Doc
verilogType HWType
hwType Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
pName Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
iE Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Applicative m => HWType -> m Doc
encodingNote HWType
hwType)
where
portType :: Ap (State VerilogState) Doc
portType =
case Maybe Usage
mu of
Just Usage
Cont ->
Ap (State VerilogState) Doc
"output wire"
Just Proc{} ->
Ap (State VerilogState) Doc
"output reg"
Maybe Usage
Nothing ->
if HWType -> Bool
isBiSignalIn HWType
hwType then Ap (State VerilogState) Doc
"inout wire" else Ap (State VerilogState) Doc
def Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"wire"
iE :: Ap (State VerilogState) Doc
iE = Ap (State VerilogState) Doc
-> (Expr -> Ap (State VerilogState) Doc)
-> Maybe Expr
-> Ap (State VerilogState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m Doc -> m Doc
noEmptyInit (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> (Expr -> Ap (State VerilogState) Doc)
-> Expr
-> Ap (State VerilogState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False) Maybe Expr
iEM
module_ :: Component -> VerilogM Doc
module_ :: Component -> Ap (State VerilogState) Doc
module_ Component
c =
Ap (State VerilogState) Doc
modVerilog Ap (State VerilogState) Doc
-> Ap (State VerilogState) () -> Ap (State VerilogState) Doc
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 (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 :: Ap (State VerilogState) Doc
modVerilog = do
Doc
body <- Ap (State VerilogState) 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
Ap (State VerilogState) Doc
modHeader Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
modPorts Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
[Text] -> Ap (State VerilogState) 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) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
[Text] -> Ap (State VerilogState) 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) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
body Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
modEnding
modHeader :: Ap (State VerilogState) Doc
modHeader = Ap (State VerilogState) Doc
"module" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Component -> Identifier
componentName Component
c)
modPorts :: Ap (State VerilogState) Doc
modPorts = Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
4 (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m [Doc] -> m Doc
tupleInputs Ap (State VerilogState) [Doc]
inPorts Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m [Doc] -> m Doc
tupleOutputs Ap (State VerilogState) [Doc]
outPorts Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
modBody :: Ap (State VerilogState) Doc
modBody = Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Declaration] -> Ap (State VerilogState) Doc
decls (Component -> [Declaration]
declarations Component
c)) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Declaration] -> Ap (State VerilogState) Doc
insts (Component -> [Declaration]
declarations Component
c))
modEnding :: Ap (State VerilogState) Doc
modEnding = Ap (State VerilogState) Doc
"endmodule"
inPorts :: Ap (State VerilogState) [Doc]
inPorts = [Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Ap (State VerilogState) Doc
-> Maybe Usage
-> Identifier
-> HWType
-> Maybe Expr
-> Ap (State VerilogState) Doc
sigPort Ap (State VerilogState) 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
[Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Ap (State VerilogState) Doc
-> Maybe Usage
-> Identifier
-> HWType
-> Maybe Expr
-> Ap (State VerilogState) Doc
sigPort Ap (State VerilogState) 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 (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
v
tupleInputs :: m [Doc] -> m Doc
tupleInputs m [Doc]
v = m [Doc]
v m [Doc] -> ([Doc] -> m Doc) -> m Doc
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen m Doc -> m Doc -> m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"// No inputs" m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
(Doc
x:[Doc]
xs) -> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen m Doc -> m Doc -> m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"// Inputs"
m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> (Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
" " m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> m Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
x)
m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m [Doc] -> m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([Doc] -> (Doc -> m Doc) -> m [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Doc]
xs Doc -> m Doc
forall (f :: Type -> Type).
(Semigroup (f Doc), Applicative f) =>
Doc -> f Doc
commafy)
m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
tupleOutputs :: m [Doc] -> m Doc
tupleOutputs m [Doc]
v = m [Doc]
v m [Doc] -> ([Doc] -> m Doc) -> m Doc
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
" // No outputs" m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen
(Doc
x:[Doc]
xs) -> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
" // Outputs"
m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> (if ([(Identifier, HWType)] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length (Component -> [(Identifier, HWType)]
inputs Component
c)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then m Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
space m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> m Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
x
else Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
" " m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> m Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
x)
m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> (if [Doc] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Doc]
xs then m Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m [Doc] -> m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([Doc] -> (Doc -> m Doc) -> m [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Doc]
xs Doc -> m Doc
forall (f :: Type -> Type).
(Semigroup (f Doc), Applicative f) =>
Doc -> f Doc
commafy))
m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen
include :: Monad m => [Text.Text] -> Ap m Doc
include :: [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)
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 :: [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)
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 -> Ap (State VerilogState) Doc
usageFileDoc Maybe Usage
_ HWType
FileType = Ap (State VerilogState) Doc
"integer"
usageFileDoc (Just Proc{}) HWType
_ = Ap (State VerilogState) Doc
"reg"
usageFileDoc Maybe Usage
_ HWType
_ = Ap (State VerilogState) Doc
"wire"
verilogType :: HWType -> VerilogM Doc
verilogType :: HWType -> Ap (State VerilogState) Doc
verilogType HWType
t = case HWType
t of
Signed Int
n -> Ap (State VerilogState) Doc
"signed" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
Clock {} -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
ClockN {} -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
Reset {} -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
Enable {} -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
HWType
Bit -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
HWType
Bool -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
HWType
FileType -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
Annotated [Attr Text]
_ HWType
ty -> HWType -> Ap (State VerilogState) Doc
verilogType HWType
ty
BiDirectional PortDirection
_ HWType
ty -> HWType -> Ap (State VerilogState) Doc
verilogType HWType
ty
HWType
_ -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap (State VerilogState) 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) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
sigDecl :: VerilogM Doc -> HWType -> VerilogM Doc
sigDecl :: Ap (State VerilogState) Doc
-> HWType -> Ap (State VerilogState) Doc
sigDecl Ap (State VerilogState) Doc
d HWType
t = HWType -> Ap (State VerilogState) Doc
verilogType HWType
t Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
d
verilogTypeMark :: HWType -> VerilogM Doc
verilogTypeMark :: HWType -> Ap (State VerilogState) Doc
verilogTypeMark = Ap (State VerilogState) Doc
-> HWType -> Ap (State VerilogState) Doc
forall a b. a -> b -> a
const Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
verilogTypeErrValue :: HWType -> VerilogM Doc
verilogTypeErrValue :: HWType -> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces Ap (State VerilogState) Doc
"1'bx")
Just Maybe Int
Nothing -> Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"'d0 /* undefined */"
Just (Just Int
x) -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Ap (State VerilogState) Doc
"1'b" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
x)) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"/* undefined */"
verilogRecSel
:: HWType
-> Int
-> VerilogM Doc
verilogRecSel :: HWType -> Int -> Ap (State VerilogState) 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) -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
Maybe (Range, HWType)
_ -> String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error String
"Can't make a record selector"
decls :: [Declaration] -> VerilogM Doc
decls :: [Declaration] -> Ap (State VerilogState) Doc
decls [] = Ap (State VerilogState) 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)
mapM Declaration -> Ap (State VerilogState) (Maybe Doc)
decl [Declaration]
ds)
case [Doc]
dsDoc of
[] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
[Doc]
_ -> Ap (State VerilogState) Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type).
Monad m =>
Ap m Doc -> Ap m [Doc] -> Ap m Doc
punctuate' Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi ([Doc] -> Ap (State VerilogState) [Doc]
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]
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
addAttrs [] Ap (State VerilogState) Doc
t = Ap (State VerilogState) Doc
t
addAttrs [Attr Text]
attrs' Ap (State VerilogState) Doc
t =
Ap (State VerilogState) Doc
"(*" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
attrs'' Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"*)" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
t
where
attrs'' :: Ap (State VerilogState) Doc
attrs'' = Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS (Text -> Ap (State VerilogState) Doc)
-> Text -> Ap (State VerilogState) 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
" = ", String -> Text
TextS.pack (Text -> String
forall a. Show a => a -> String
show Text
value)]
renderAttr (IntegerAttr Text
key Integer
value) = [Text] -> Text
TextS.concat [Text
key, Text
" = ", String -> Text
TextS.pack (Integer -> String
forall a. Show a => a -> String
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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> (Text
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Maybe Text
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. a -> a
id Text -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
(Monoid (f Doc), Applicative f, IsString (f Doc)) =>
Text -> f Doc -> f Doc
addNote Maybe Text
noteM ([Attr Text]
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
addAttrs [Attr Text]
attrs (Maybe Usage -> HWType -> Ap (State VerilogState) Doc
usageFileDoc Maybe Usage
u HWType
tyE Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Ap (State VerilogState) Doc
tyDec HWType
tyE))
where
tyDec :: HWType -> Ap (State VerilogState) Doc
tyDec HWType
ty = Ap (State VerilogState) Doc
-> HWType -> Ap (State VerilogState) Doc
sigDecl (Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) HWType
ty Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) 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 :: Ap (State VerilogState) Doc
iE = Ap (State VerilogState) Doc
-> (Expr -> Ap (State VerilogState) Doc)
-> Maybe Expr
-> Ap (State VerilogState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m Doc -> m Doc
noEmptyInit (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> (Expr -> Ap (State VerilogState) Doc)
-> Expr
-> Ap (State VerilogState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False) Maybe Expr
iEM
decl Declaration
_ = Maybe Doc -> Ap (State VerilogState) (Maybe Doc)
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 :: 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] -> Ap (State VerilogState) Doc
insts [] = Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
insts (TickDecl (Comment Text
c):[Declaration]
ds) = Text -> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> Text -> f Doc
comment Text
"//" Text
c Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Ap (State VerilogState) Doc
insts [Declaration]
ds
insts (TickDecl (Directive Text
d):[Declaration]
ds) = Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
d Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
";" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Ap (State VerilogState) 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] -> Ap (State VerilogState) Doc
insts [Declaration]
ds
Just Doc
doc -> Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
doc Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Ap (State VerilogState) Doc
insts [Declaration]
ds
stdMatch
:: Bits a
=> Int
-> a
-> a
-> String
stdMatch :: Int -> a -> a -> String
stdMatch Int
0 a
_mask a
_value = []
stdMatch Int
size a
mask a
value =
Char
symbol Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> a -> a -> String
forall a. Bits a => Int -> a -> a -> String
stdMatch (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
mask a
value
where
symbol :: Char
symbol =
if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
mask (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then
if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
value (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then
Char
'1'
else
Char
'0'
else
Char
'?'
patLitCustom'
:: Int
-> ConstrRepr'
-> VerilogM Doc
patLitCustom' :: Int -> ConstrRepr' -> Ap (State VerilogState) Doc
patLitCustom' Int
size (ConstrRepr' Text
_name Int
_n Integer
mask Integer
value [Integer]
_anns) =
Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
size Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"b" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> (Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Ap (State VerilogState) Doc)
-> Text -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Integer -> String
forall a. Bits a => Int -> a -> a -> String
stdMatch Int
size Integer
mask Integer
value)
patLitCustom
:: HWType
-> Literal
-> VerilogM Doc
patLitCustom :: HWType -> Literal -> Ap (State VerilogState) 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' -> Ap (State VerilogState) 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. [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. [a] -> Int -> a
!! Int
i in
Int -> ConstrRepr' -> Ap (State VerilogState) 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' -> Ap (State VerilogState) Doc
patLitCustom' Int
size ConstrRepr'
cRepr
patLitCustom HWType
x Literal
y = String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error (String -> Ap (State VerilogState) Doc)
-> String -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
[ String
"You can only pass CustomSP / CustomSum / CustomProduct and a NumLit to "
, String
"this function, not", HWType -> String
forall a. Show a => a -> String
show HWType
x, String
"and", Literal -> String
forall a. Show a => a -> String
show Literal
y ]
patMod :: HWType -> Literal -> Literal
patMod :: HWType -> Literal -> Literal
patMod HWType
hwTy (NumLit Integer
i) = Integer -> Literal
NumLit (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ HWType -> Int
typeSize HWType
hwTy))
patMod HWType
_ Literal
l = Literal
l
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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc))
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
Ap (State VerilogState) Doc
"always @(*) begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 Ap (State VerilogState) Doc
casez Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"end"
where
casez :: Ap (State VerilogState) Doc
casez =
Ap (State VerilogState) Doc
"casez" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Ap (State VerilogState) Doc
var Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([(Maybe Literal, Expr)] -> Ap (State VerilogState) Doc
conds [(Maybe Literal, Expr)]
esNub) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) 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 (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 (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 :: Ap (State VerilogState) Doc
var = Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
True Expr
scrut
conds :: [(Maybe Literal,Expr)] -> VerilogM Doc
conds :: [(Maybe Literal, Expr)] -> Ap (State VerilogState) Doc
conds [] = String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error (String -> Ap (State VerilogState) Doc)
-> String -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Empty list of conditions invalid."
conds [(Maybe Literal
_,Expr
e)] = Ap (State VerilogState) Doc
"default" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
":" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
id_ Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"=" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
";"
conds ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_) = Ap (State VerilogState) Doc
"default" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
":" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
id_ Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"=" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
";"
conds ((Just Literal
c ,Expr
e):[(Maybe Literal, Expr)]
es') =
Ap (State VerilogState) Doc
mask' Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
":" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
id_ Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"=" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
";" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [(Maybe Literal, Expr)] -> Ap (State VerilogState) Doc
conds [(Maybe Literal, Expr)]
es'
where
mask' :: Ap (State VerilogState) Doc
mask' = HWType -> Literal -> Ap (State VerilogState) 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 (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 (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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc))
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
Ap (State VerilogState) Doc
"assign" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) 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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc))
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
Ap (State VerilogState) Doc
"always @(*) begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VerilogState) Doc
"if" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
True Expr
scrut) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
(Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
t Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"else" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
(Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
f Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) 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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc))
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
Ap (State VerilogState) Doc
"always @(*) begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VerilogState) Doc
"case" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
True Expr
scrut) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
(Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Ap (State VerilogState) 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)) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"endcase") Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) 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 (m :: Type -> Type) a. Monad m => a -> m a
return []
conds Text
i [(Maybe Literal
_,Expr
e)] = (Ap (State VerilogState) Doc
"default" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
i Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e) Ap (State VerilogState) 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 (m :: Type -> Type) a. Monad m => a -> m a
return []
conds Text
i ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_) = (Ap (State VerilogState) Doc
"default" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
i Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e) Ap (State VerilogState) 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 (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 -> Ap (State VerilogState) Doc
exprLitV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
scrutTy,HWType -> Int
conSize HWType
scrutTy)) Literal
c Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
i Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e) Ap (State VerilogState) 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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc))
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
Ap (State VerilogState) Doc
attrs' Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
params Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
lbl Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
pms2 Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
where
pms2 :: Ap (State VerilogState) Doc
pms2 = case PortMap
pms0 of
NamedPortMap [(Expr, PortDirection, HWType, Expr)]
pms1 ->
let pm :: Expr -> Expr -> Ap (State VerilogState) Doc
pm Expr
i Expr
e = Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
i Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e) in
Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ [Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Expr -> Expr -> Ap (State VerilogState) 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] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ [Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e | (PortDirection
_,HWType
_,Expr
e) <- [(PortDirection, HWType, Expr)]
pms1]
params :: Ap (State VerilogState) Doc
params
| [(Expr, HWType, Expr)] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Expr, HWType, Expr)]
ps = Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
space
| Bool
otherwise = Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"#" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ([Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
i Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e) | (Expr
i,HWType
_,Expr
e) <- [(Expr, HWType, Expr)]
ps]) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
attrs' :: Ap (State VerilogState) Doc
attrs'
| [Attr Text] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Attr Text]
attrs = Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
| Bool
otherwise = [Attr Text]
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
addAttrs [Attr Text]
attrs Ap (State VerilogState) 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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (State VerilogState Doc -> Ap (State VerilogState) Doc
forall k (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (StateT VerilogState Identity (Int -> Doc) -> State VerilogState Doc
forall (f :: Type -> Type). Functor f => f (Int -> Doc) -> f Doc
column ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VerilogState Identity (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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Seq] -> Ap (State VerilogState) Doc
seqs [Seq]
ds
inst_ (NetDecl' {}) = Maybe Doc -> Ap (State VerilogState) (Maybe Doc)
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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
Ap (State VerilogState) Doc
"`ifdef" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
cond Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Declaration] -> Ap (State VerilogState) Doc
insts [Declaration]
ds) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"`endif"
inst_ Declaration
d =
String -> Ap (State VerilogState) (Maybe Doc)
forall a. HasCallStack => String -> a
error (String
"inst_: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Declaration -> String
forall a. Show a => a -> String
show Declaration
d)
seq_ :: Seq -> VerilogM Doc
seq_ :: Seq -> Ap (State VerilogState) Doc
seq_ (AlwaysClocked ActiveEdge
edge Expr
clk [Seq]
ds) =
Ap (State VerilogState) Doc
"always @" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (case ActiveEdge
edge of {ActiveEdge
Rising -> Ap (State VerilogState) Doc
"posedge"; ActiveEdge
_ -> Ap (State VerilogState) Doc
"negedge"} Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
clk) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> Ap (State VerilogState) Doc
seqs [Seq]
ds) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"end"
seq_ (Initial [Seq]
ds) =
Ap (State VerilogState) Doc
"initial begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> Ap (State VerilogState) Doc
seqs [Seq]
ds) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"end"
seq_ (AlwaysComb [Seq]
ds) =
Ap (State VerilogState) Doc
"always @* begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> Ap (State VerilogState) Doc
seqs [Seq]
ds) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"end"
seq_ (Branch Expr
scrut HWType
scrutTy [(Maybe Literal, [Seq])]
es) =
Ap (State VerilogState) Doc
"case" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
True Expr
scrut) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
(Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ [(Maybe Literal, [Seq])] -> Ap (State VerilogState) [Doc]
conds [(Maybe Literal, [Seq])]
es) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"endcase"
where
conds :: [(Maybe Literal,[Seq])] -> VerilogM [Doc]
conds :: [(Maybe Literal, [Seq])] -> Ap (State VerilogState) [Doc]
conds [] =
[Doc] -> Ap (State VerilogState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
conds [(Maybe Literal
_,[Seq]
sq)] =
(Ap (State VerilogState) Doc
"default" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> Ap (State VerilogState) Doc
seqs [Seq]
sq) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"end") Ap (State VerilogState) 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 (m :: Type -> Type) a. Monad m => a -> m a
return []
conds ((Maybe Literal
Nothing,[Seq]
sq):[(Maybe Literal, [Seq])]
_) =
(Ap (State VerilogState) Doc
"default" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> Ap (State VerilogState) Doc
seqs [Seq]
sq) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"end") Ap (State VerilogState) 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 (m :: Type -> Type) a. Monad m => a -> m a
return []
conds ((Just Literal
c ,[Seq]
sq):[(Maybe Literal, [Seq])]
es') =
(Maybe (HWType, Int) -> Literal -> Ap (State VerilogState) Doc
exprLitV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
scrutTy,HWType -> Int
conSize HWType
scrutTy)) Literal
c Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> Ap (State VerilogState) Doc
seqs [Seq]
sq) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"end") Ap (State VerilogState) 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 :: Ap (State VerilogState) Doc
op = case Blocking
b of { Blocking
Blocking -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals; Blocking
NonBlocking -> Ap (State VerilogState) Doc
"<=" }
in Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
op Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False Expr
e Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) 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)
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) (Maybe Doc -> Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc Ap (State VerilogState) (Maybe Doc -> Doc)
-> Ap (State VerilogState) (Maybe Doc)
-> Ap (State VerilogState) Doc
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] -> Ap (State VerilogState) Doc
seqs [Seq]
ds
Declaration
_ -> String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error (String
"seq_: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Declaration -> String
forall a. Show a => a -> String
show Declaration
sd)
seqs :: [Seq] -> VerilogM Doc
seqs :: [Seq] -> Ap (State VerilogState) Doc
seqs [] = Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
seqs (SeqDecl (TickDecl (Comment Text
c)):[Seq]
ds) = Text -> Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> Text -> f Doc
comment Text
"//" Text
c Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Seq] -> Ap (State VerilogState) Doc
seqs [Seq]
ds
seqs (SeqDecl (TickDecl (Directive Text
d)):[Seq]
ds) = Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
d Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
";" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Seq] -> Ap (State VerilogState) Doc
seqs [Seq]
ds
seqs (Seq
d:[Seq]
ds) = Seq -> Ap (State VerilogState) Doc
seq_ Seq
d Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> [Seq] -> Ap (State VerilogState) 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 (p :: Type -> Type -> Type) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Int, Int, Provenance)
newSplitRange(Int, Int, Provenance)
-> [(Int, Int, Provenance)] -> [(Int, Int, Provenance)]
forall a. a -> [a] -> [a]
:) ([(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) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL [(Int, Int)]
-> (Int, Int, Provenance)
-> ([(Int, Int)], [(Int, Int, Provenance)])
inRange [(Int, Int)]
ses [(Int, Int, Provenance)]
rs)) of
[] -> String -> (Range, HWType)
forall a. HasCallStack => String -> a
error String
"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 :: 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. [a] -> Int -> a
!! Int
dcI
argTy :: HWType
argTy = [HWType]
argTys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI
argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
other :: Int
other = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
other
end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
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. [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. [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. [a] -> Int -> a
!! Int
dcI
argTy :: HWType
argTy = [HWType]
argTys [HWType] -> Int -> HWType
forall a. [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. [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. [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)] -> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int ([Bit] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Bit]
ns) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"b" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Bit -> Ap (State VerilogState) 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)
mapM (Lens' VerilogState (Maybe (Maybe Int))
-> Bit -> Ap (State VerilogState) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Ap (State s) Doc
bit_char Lens' VerilogState (Maybe (Maybe Int))
undefValue) [Bit]
ns)
[BitOrigin]
_ -> String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error String
"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 (String -> Text
Text.pack (Text -> String
TextS.unpack (Identifier -> Text
Id.toText Identifier
funId) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".inc")))
Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
funId Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (((HWType, Expr) -> Ap (State VerilogState) 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)
mapM (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False (Expr -> Ap (State VerilogState) Doc)
-> ((HWType, Expr) -> Expr)
-> (HWType, Expr)
-> Ap (State VerilogState) 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) 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)
mapM (\Int
n -> Text -> Ap (State VerilogState) Identifier
forall (m :: Type -> Type).
IdentifierSetMonad m =>
Text -> m Identifier
mkId (String -> Text
TextS.pack (Char
'v'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
n))) [Int
1..[(HWType, Expr)] -> 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 :: [Ap (State VerilogState) Doc]
fInps =
[ case HWType -> Int
typeSize HWType
t of
Int
0 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
Int
1 -> Ap (State VerilogState) Doc
"input" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
i Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
Int
n -> Ap (State VerilogState) Doc
"input" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
i Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
range' (Lit ([Bit] -> [Bit]
bitsToBits -> [Bit]
ns)) =
Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int ([Bit] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Bit]
ns) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"b" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Bit -> Ap (State VerilogState) 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)
mapM (Lens' VerilogState (Maybe (Maybe Int))
-> Bit -> Ap (State VerilogState) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Ap (State s) Doc
bit_char 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. [a] -> Int -> a
!! Int
n
aTy :: HWType
aTy = [HWType]
aTys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
n
in case HWType -> Int
typeSize HWType
aTy of
Int
0 -> String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error String
"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 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
v
else
String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error String
"internal error"
Int
_ -> Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
v Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
let val :: Ap (State VerilogState) Doc
val = case [BitOrigin]
origins of
[] -> String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error String
"internal error"
[BitOrigin
r] -> BitOrigin -> Ap (State VerilogState) Doc
range' BitOrigin
r
[BitOrigin]
rs -> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((BitOrigin -> Ap (State VerilogState) 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)
mapM BitOrigin -> Ap (State VerilogState) Doc
range' [BitOrigin]
rs)
let oSz :: Ap (State VerilogState) Doc
oSz = case Int
size of
Int
0 -> String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error String
"internal error"
Int
1 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
Int
n -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
Doc
funDoc <-
Ap (State VerilogState) Doc
"function" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
oSz Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
fId Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ([Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Ap (State VerilogState) Doc]
fInps) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"begin" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
fId Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"=" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
val Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"end" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<>
Ap (State VerilogState) Doc
"endfunction"
State VerilogState () -> Ap (State VerilogState) ()
forall k (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (([(String, Doc)] -> Identity [(String, Doc)])
-> VerilogState -> Identity VerilogState
Lens' VerilogState [(String, Doc)]
includes (([(String, Doc)] -> Identity [(String, Doc)])
-> VerilogState -> Identity VerilogState)
-> ([(String, Doc)] -> [(String, Doc)]) -> State VerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Text -> String
TextS.unpack (Identifier -> Text
Id.toText Identifier
fId) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".inc",Doc
funDoc)(String, Doc) -> [(String, Doc)] -> [(String, Doc)]
forall a. a -> [a] -> [a]
:))
Identifier -> Ap (State VerilogState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
fId
expr_ :: Bool
-> Expr
-> VerilogM Doc
expr_ :: Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
_ (Literal Maybe (HWType, Int)
sizeM Literal
lit) = Maybe (HWType, Int) -> Literal -> Ap (State VerilogState) Doc
exprLitV Maybe (HWType, Int)
sizeM Literal
lit
expr_ Bool
_ (Identifier Identifier
id_ Maybe Modifier
Nothing) = Identifier -> Ap (State VerilogState) 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 {} -> String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
HWType
_ -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Ap (State VerilogState) Doc
", " (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc])
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Ap (State VerilogState) 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. [a] -> Int -> a
!! Int
dcI
ranges :: [Ap (State VerilogState) Doc]
ranges = ((Int, Int) -> Ap (State VerilogState) Doc)
-> [(Int, Int)] -> [Ap (State VerilogState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
(Semigroup (f Doc), Applicative f, IsString (f Doc)) =>
(Int, Int) -> f Doc
range' ([(Int, Int)] -> [Ap (State VerilogState) Doc])
-> [(Int, Int)] -> [Ap (State VerilogState) Doc]
forall a b. (a -> b) -> a -> b
$ Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. [a] -> Int -> a
!! Int
fI)
range' :: (Int, Int) -> f Doc
range' (Int
start, Int
end) = Identifier -> f Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
":" f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
fieldTy :: HWType
fieldTy = String -> [HWType] -> Int -> HWType
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"panic") [HWType]
fieldTypes Int
fI
expr_ Bool
_ (Identifier Identifier
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 :: [Ap (State VerilogState) Doc]
ranges = ((Int, Int) -> Ap (State VerilogState) Doc)
-> [(Int, Int)] -> [Ap (State VerilogState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Ap (State VerilogState) 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. [a] -> Int -> a
!! Int
fI)) in
case HWType
fieldTy of
Void {} -> String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
HWType
_ -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Ap (State VerilogState) Doc
", " (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc])
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Ap (State VerilogState) Doc]
ranges
where
(Integer
_fieldAnn, HWType
fieldTy) = String -> [(Integer, HWType)] -> Int -> (Integer, HWType)
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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
-> String
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$
Identifier -> Ap (State VerilogState) 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
-> String
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$
Identifier -> Ap (State VerilogState) 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
-> String
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc
forall a. Bool -> String -> a -> a
traceIf Bool
True ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: synthesizing bitvector mask to dontcare") (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$
HWType -> Ap (State VerilogState) 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
-> String
-> Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$
Identifier -> Ap (State VerilogState) 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 -> Ap (State VerilogState) 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
_ -> Ap (State VerilogState) Doc
"$signed" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
(Semigroup (f Doc), Applicative f) =>
Int -> Int -> f Doc
slice Int
start Int
end)
HWType
_ -> Int -> Int -> Ap (State VerilogState) 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 :: Ap (State VerilogState) Doc
rs1 = Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces (((Int, Int, Provenance) -> Ap (State VerilogState) 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)
mapM (\(Int
start,Int
end,Provenance
_) -> Int -> Int -> Ap (State VerilogState) 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
_ -> Ap (State VerilogState) Doc
"$signed" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Ap (State VerilogState) Doc
rs1
HWType
_ -> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
expr_ Bool
b Expr
e
expr_ Bool
_ (DataCon ty :: HWType
ty@(Vector Int
0 HWType
_) Modifier
_ [Expr]
_) = HWType -> Ap (State VerilogState) Doc
verilogTypeErrValue HWType
ty
expr_ Bool
_ (DataCon (Vector Int
1 HWType
_) Modifier
_ [Expr
e]) = Bool -> Expr -> Ap (State VerilogState) 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] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ (Expr -> Ap (State VerilogState) 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)
mapM (Bool -> Expr -> Ap (State VerilogState) 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 String
runs0) <- Expr
runs
, Literal Maybe (HWType, Int)
Nothing (StringLit String
ends0) <- Expr
ends
, [Natural]
es <- Int -> Int -> ByteString -> ByteString -> [Natural]
unpackNats Int
n Int
m (String -> ByteString
B8.pack String
runs0) (String -> ByteString
B8.pack String
ends0) =
let el :: a -> Ap (State VerilogState) Doc
el a
val = Maybe (HWType, Int) -> Literal -> Ap (State VerilogState) 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] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ (Natural -> Ap (State VerilogState) 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)
mapM Natural -> Ap (State VerilogState) Doc
forall a. Integral a => a -> Ap (State VerilogState) Doc
el [Natural]
es
expr_ Bool
_ (DataCon (RTree Int
0 HWType
_) Modifier
_ [Expr
e]) = Bool -> Expr -> Ap (State VerilogState) 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] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ (Expr -> Ap (State VerilogState) 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)
mapM (Bool -> Expr -> Ap (State VerilogState) 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) = Ap (State VerilogState) Doc
assignExpr
where
argExprs :: [Ap (State VerilogState) Doc]
argExprs = (Expr -> Ap (State VerilogState) Doc)
-> [Expr] -> [Ap (State VerilogState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False) [Expr]
es
assignExpr :: Ap (State VerilogState) Doc
assignExpr = Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Ap (State VerilogState) 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
$ [Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Ap (State VerilogState) Doc]
argExprs)
expr_ Bool
_ (DataCon ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) = Ap (State VerilogState) 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. [a] -> Int -> a
!! Int
i
dcSize :: Int
dcSize = HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ((HWType -> Int) -> [HWType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Int
typeSize [HWType]
argTys)
dcExpr :: Ap (State VerilogState) Doc
dcExpr = Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
argExprs :: [Ap (State VerilogState) Doc]
argExprs = (Expr -> Ap (State VerilogState) Doc)
-> [Expr] -> [Ap (State VerilogState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False) [Expr]
es
extraArg :: [Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"'b" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Lens' VerilogState (Maybe (Maybe Int))
-> [Bit] -> Ap (State VerilogState) Doc
forall s. Lens' s (Maybe (Maybe Int)) -> [Bit] -> Ap (State s) Doc
bits Lens' VerilogState (Maybe (Maybe Int))
undefValue (Int -> Bit -> [Bit]
forall a. Int -> a -> [a]
replicate Int
n Bit
U)]
assignExpr :: Ap (State VerilogState) Doc
assignExpr = Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc)
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VerilogState) Doc
-> Ap (State VerilogState) [Doc] -> Ap (State VerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Ap (State VerilogState) 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
$ [Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Ap (State VerilogState) Doc
dcExprAp (State VerilogState) Doc
-> [Ap (State VerilogState) Doc] -> [Ap (State VerilogState) Doc]
forall a. a -> [a] -> [a]
:[Ap (State VerilogState) Doc]
argExprs [Ap (State VerilogState) Doc]
-> [Ap (State VerilogState) Doc] -> [Ap (State VerilogState) Doc]
forall a. [a] -> [a] -> [a]
++ [Ap (State VerilogState) Doc]
extraArg))
expr_ Bool
_ (DataCon ty :: HWType
ty@(Sum Text
_ [Text]
_) (DC (HWType
_,Int
i)) []) = Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"'d" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) 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. [a] -> Int -> a
!! Int
i in
Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"d" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) 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. [a] -> Int -> a
!! Int
constrNr in
DataRepr'
-> ConstrRepr' -> [(HWType, Expr)] -> Ap (State VerilogState) 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)] -> Ap (State VerilogState) 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] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> Ap (State VerilogState) 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)
mapM (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
False) [Expr]
es)
expr_ Bool
_ (DataCon (Enable Text
_) Modifier
_ [Expr
e]) =
Bool -> Expr -> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
exprLitV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Signed (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) Literal
i
expr_ 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 -> Ap (State VerilogState) Doc
exprLitV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) Literal
i
expr_ 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 -> Ap (State VerilogState) Doc
exprLitV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
BitVector (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) (Integer -> Integer -> Literal
BitVecLit Integer
m' Integer
i')
expr_ 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 -> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
forall s.
Lens' s (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Ap (State s) Doc
exprLit Lens' VerilogState (Maybe (Maybe Int))
undefValue ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Integer -> HWType
Index (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) Literal
i
expr_ Bool
b (BlackBoxE Text
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx Bool
b') = do
Bool -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Monad m => Bool -> m Doc -> m Doc
parenIf (Bool
b Bool -> Bool -> Bool
|| Bool
b') (State VerilogState Doc -> Ap (State VerilogState) Doc
forall k (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VerilogState Identity (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 StateT VerilogState Identity (Int -> Doc)
-> State VerilogState Int -> State VerilogState Doc
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Int -> State VerilogState Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0))
expr_ Bool
_ (DataTag HWType
Bool (Left Identifier
id_)) = Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap (State VerilogState) 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)
Ap (State VerilogState) Doc
"$unsigned" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State VerilogState) [Doc] -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ([Ap (State VerilogState) Doc] -> Ap (State VerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
iwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces Ap (State VerilogState) Doc
"1'b0"),Identifier -> Ap (State VerilogState) 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_)) = Ap (State VerilogState) Doc
"$unsigned" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Ap (State VerilogState) 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_)) = Ap (State VerilogState) Doc
"$unsigned" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"'sd0"
expr_ Bool
_ (DataTag hty :: HWType
hty@(SP Text
_ [(Text, [HWType])]
_) (Right Identifier
id_)) = Ap (State VerilogState) Doc
"$unsigned" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens
(Identifier -> Ap (State VerilogState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets
(Int -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) 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 -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VerilogState) Doc
"'sd1"
expr_ Bool
b (ToBv Maybe Identifier
_ HWType
_ Expr
e) = Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
b Expr
e
expr_ Bool
b (FromBv Maybe Identifier
_ HWType
_ Expr
e) = Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
b Expr
e
expr_ Bool
b (IfThenElse Expr
c Expr
t Expr
e) =
Bool -> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (m :: Type -> Type). Monad m => Bool -> m Doc -> m Doc
parenIf Bool
b (Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
True Expr
c Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
"?" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
True Expr
t Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VerilogState) Doc
":" Ap (State VerilogState) Doc
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> Ap (State VerilogState) Doc
expr_ Bool
True Expr
e)
expr_ Bool
_ Expr
e = String -> Ap (State VerilogState) Doc
forall a. HasCallStack => String -> a
error (String -> Ap (State VerilogState) Doc)
-> String -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Expr -> String
forall a. Show a => a -> String
show Expr
e)
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 -> Ap (State VerilogState) Doc
exprLitV = Lens' VerilogState (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Ap (State VerilogState) Doc
forall s.
Lens' s (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Ap (State s) Doc
exprLit Lens' VerilogState (Maybe (Maybe Int))
undefValue
exprLit :: Lens' s (Maybe (Maybe Int)) -> Maybe (HWType,Size) -> Literal -> Ap (State s) Doc
exprLit :: 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
i0) = 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 Lens' s (Maybe (Maybe Int))
k (Int -> Integer -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz Integer
i)
i :: Integer
i = case HWType
hty of
Signed Int
_ -> let mask :: Integer
mask = Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) in case Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i0 Integer
mask of
(Integer
s,Integer
i'') | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
s -> Integer
i''
| Bool
otherwise -> Integer
i''