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

  Generate Verilog for assorted Netlist datatypes
-}

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

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

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

import           Clash.Annotations.Primitive          (HDL (..))
import           Clash.Annotations.BitRepresentation.ClashLib
  (bitsToBits)
import           Clash.Annotations.BitRepresentation.Internal
  (ConstrRepr'(..), DataRepr'(..), ConstrRepr'(..))
import           Clash.Annotations.BitRepresentation.Util
  (BitOrigin(Lit, Field), bitOrigins, bitRanges)
import           Clash.Core.Var                       (Attr'(..))
import           Clash.Backend
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                  hiding (_intWidth, intWidth)
import           Clash.Netlist.Util
import           Clash.Signal.Internal                (ActiveEdge (..))
import           Clash.Util
  (SrcSpan, noSrcSpan, curLoc, indexNote, makeCached)

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

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 Backend VerilogState where
  initBackend :: ClashOpts -> VerilogState
initBackend ClashOpts
opts = VerilogState :: Int
-> IdentifierSet
-> SrcSpan
-> [(String, Doc)]
-> HashSet Text
-> HashSet Text
-> [(String, String)]
-> [(String, String)]
-> HashMap Text Identifier
-> Int
-> HdlSyn
-> Maybe (Maybe Int)
-> AggressiveXOptBB
-> DomainMap
-> 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
    , _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
    }
  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 :: Text
-> SrcSpan
-> IdentifierSet
-> Component
-> Ap (State VerilogState) ((String, Doc), [(String, Doc)])
genHDL          = (SrcSpan
 -> IdentifierSet
 -> Component
 -> Ap (State VerilogState) ((String, Doc), [(String, Doc)]))
-> Text
-> SrcSpan
-> IdentifierSet
-> Component
-> Ap (State VerilogState) ((String, Doc), [(String, Doc)])
forall a b. a -> b -> a
const SrcSpan
-> IdentifierSet
-> 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 -- Everything is a bitvector!
  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
  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

-- | Generate Verilog for a Netlist component
genVerilog
  :: SrcSpan
  -> IdentifierSet
  -> Component
  -> VerilogM ((String, Doc), [(String, Doc)])
genVerilog :: SrcSpan
-> IdentifierSet
-> Component
-> Ap (State VerilogState) ((String, Doc), [(String, Doc)])
genVerilog SrcSpan
sp IdentifierSet
seen Component
c = do
    -- Don't have type names conflict with module names or with previously
    -- generated type names.
    --
    -- TODO: Collect all type names up front, to prevent relatively costly union.
    -- TODO: Investigate whether type names / signal names collide in the first place
    State VerilogState () -> Ap (State VerilogState) ()
forall k (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VerilogState () -> Ap (State VerilogState) ())
-> State VerilogState () -> Ap (State VerilogState) ()
forall a b. (a -> b) -> a -> b
$ (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

    State VerilogState () -> Ap (State VerilogState) ()
forall k (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (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
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
"*/"
    timescale :: Ap (State VerilogState) Doc
timescale = Ap (State VerilogState) Doc
"`timescale 100fs/100fs"

sigPort
  :: Maybe WireOrReg
  -> Identifier
  -> HWType
  -> Maybe Expr
  -> VerilogM Doc
sigPort :: Maybe WireOrReg
-> Identifier
-> HWType
-> Maybe Expr
-> Ap (State VerilogState) Doc
sigPort Maybe WireOrReg
wor (Identifier -> Text
Id.toText -> Text
pName) HWType
hwType Maybe Expr
iEM =
    [Attr']
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
addAttrs (HWType -> [Attr']
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 WireOrReg
wor of
                 Maybe WireOrReg
Nothing   -> if HWType -> Bool
isBiSignalIn HWType
hwType then Ap (State VerilogState) Doc
"inout" else Ap (State VerilogState) Doc
"input"
                 Just WireOrReg
Wire -> Ap (State VerilogState) Doc
"output" 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"
                 Just WireOrReg
Reg  -> Ap (State VerilogState) Doc
"output" 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
"reg"

    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 [ Maybe WireOrReg
-> Identifier
-> HWType
-> Maybe Expr
-> Ap (State VerilogState) Doc
sigPort Maybe WireOrReg
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 = [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 [ Maybe WireOrReg
-> Identifier
-> HWType
-> Maybe Expr
-> Ap (State VerilogState) Doc
sigPort (WireOrReg -> Maybe WireOrReg
forall a. a -> Maybe a
Just WireOrReg
wireOrReg) Identifier
id_ HWType
hwType Maybe Expr
iEM | (WireOrReg
wireOrReg, (Identifier
id_, HWType
hwType), Maybe Expr
iEM) <- Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c ]

    -- slightly more readable than 'tupled', makes the output Haskell-y-er
    commafy :: Doc -> f Doc
commafy Doc
v = (f Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
space) f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> f Doc
forall (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
<>
  -- NOTE: We must produce a single uselib directive as later ones overwrite earlier ones.
  Int -> Ap m Doc -> Ap m Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Text -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"`uselib" Ap m Doc -> Ap m Doc -> Ap m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (Ap m [Doc] -> Ap m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hsep ((Text -> Ap m Doc) -> [Text] -> Ap m [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
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

wireRegFileDoc :: WireOrReg -> (Either a HWType) -> VerilogM Doc
wireRegFileDoc :: WireOrReg -> Either a HWType -> Ap (State VerilogState) Doc
wireRegFileDoc WireOrReg
_    (Right HWType
FileType) = Ap (State VerilogState) Doc
"integer"
wireRegFileDoc WireOrReg
Wire Either a HWType
_                = Ap (State VerilogState) Doc
"wire"
wireRegFileDoc WireOrReg
Reg  Either a HWType
_                = Ap (State VerilogState) Doc
"reg"

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
  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']
_ 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

-- | Convert a Netlist HWType to the root of a Verilog type
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

-- | Convert a Netlist HWType to an error Verilog value for that type
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)

-- | Add attribute notation to given declaration
addAttrs
  :: [Attr']
  -> VerilogM Doc
  -> VerilogM Doc
addAttrs :: [Attr']
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
addAttrs []     Ap (State VerilogState) Doc
t = Ap (State VerilogState) Doc
t
addAttrs [Attr']
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
string (Text -> Ap (State VerilogState) Doc)
-> Text -> Ap (State VerilogState) Doc
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
", " ((Attr' -> Text) -> [Attr'] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Attr' -> Text
renderAttr [Attr']
attrs')

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

decl :: Declaration -> VerilogM (Maybe Doc)
decl :: Declaration -> Ap (State VerilogState) (Maybe Doc)
decl (NetDecl' Maybe Text
noteM WireOrReg
wr Identifier
id_ Either Text HWType
tyE Maybe Expr
iEM) =
  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']
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
addAttrs [Attr']
attrs (WireOrReg -> Either Text HWType -> Ap (State VerilogState) Doc
forall a.
WireOrReg -> Either a HWType -> Ap (State VerilogState) Doc
wireRegFileDoc WireOrReg
wr Either Text 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
<+> Either Text HWType -> Ap (State VerilogState) Doc
tyDec Either Text HWType
tyE))
  where
    tyDec :: Either Text HWType -> Ap (State VerilogState) Doc
tyDec (Left  Text
ty) = Text -> Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
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
<+> 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
iE
    tyDec (Right 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']
attrs = [Attr'] -> Maybe [Attr'] -> [Attr']
forall a. a -> Maybe a -> a
fromMaybe [] (HWType -> [Attr']
hwTypeAttrs (HWType -> [Attr']) -> Maybe HWType -> Maybe [Attr']
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (Text -> Maybe HWType)
-> (HWType -> Maybe HWType) -> Either Text HWType -> Maybe HWType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe HWType -> Text -> Maybe HWType
forall a b. a -> b -> a
const Maybe HWType
forall a. Maybe a
Nothing) HWType -> Maybe HWType
forall a. a -> Maybe a
Just Either Text 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

-- | Helper function for inst_, handling CustomSP and CustomSum
inst_'
  :: TextS.Text
  -> Expr
  -> HWType
  -> [(Maybe Literal, Expr)]
  -> VerilogM (Maybe Doc)
inst_' :: Text
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Ap (State VerilogState) (Maybe Doc)
inst_' Text
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es = (Doc -> Maybe Doc)
-> 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

-- | Turn a Netlist Declaration to a Verilog concurrent block
inst_ :: Declaration -> VerilogM (Maybe Doc)
inst_ :: Declaration -> Ap (State VerilogState) (Maybe Doc)
inst_ (TickDecl {}) = Maybe Doc -> Ap (State VerilogState) (Maybe Doc)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing
inst_ (Assignment Identifier
id_ 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']
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 ->
        -- ( .clk (clk_0), .arst (arst_0), ........ )
        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 ->
         -- ( clk_0, arst_0, ..... )
        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'] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Attr']
attrs = Ap (State VerilogState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
      | Bool
otherwise  = [Attr']
-> Ap (State VerilogState) Doc -> Ap (State VerilogState) Doc
addAttrs [Attr']
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"

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_ Expr
e ->
    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

  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

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

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

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

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

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

next start: 4
next end:   1

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

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

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

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

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

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

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

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

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

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

        newSplitRange :: (Int, Int, Provenance)
newSplitRange =
          ( Int
startRangeNew
          , Int
endRangeNew
          , Int -> Int -> Provenance
Provenance Int
startProvenanceNew Int
endProvenanceNew)
    in
    if Int
endOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then
      -- try to slice the next start+end in the current split range element
      ([(Int, Int, Provenance)] -> [(Int, Int, Provenance)])
-> ([(Int, Int)], [(Int, Int, Provenance)])
-> ([(Int, Int)], [(Int, Int, Provenance)])
forall (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
      -- continue the slice in the next split range element
      ((Int
endProvenanceInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
end)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[(Int, Int)]
ses,[(Int, Int, Provenance)
newSplitRange])
  else
    -- start offset beyond last bit in the element of the split range
    ((Int
start,Int
end)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[(Int, Int)]
ses,[])

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

-- | Select a sub-range from a range
continueWithRange
  :: [(Int,Int)]
  -- ^ Starts and ends
  -> HWType
  -- ^ Type of the projection
  -> Range
  -- ^ Range selected so far
  -> (Range, HWType)
continueWithRange :: [(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
hty Range
r = case Range
r of
  Contiguous Int
_ Int
offset -> case [(Int, Int)]
ses of
    [(Int
start,Int
end)] ->
      (Int -> Int -> Range
Contiguous (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset), HWType
hty)
    [(Int, Int)]
ses1 ->
      let ses2 :: [(Int, Int, Provenance)]
ses2 = (Int, [(Int, Int, Provenance)]) -> [(Int, Int, Provenance)]
forall a b. (a, b) -> b
snd ((Int -> (Int, Int) -> (Int, (Int, Int, Provenance)))
-> Int -> [(Int, Int)] -> (Int, [(Int, Int, Provenance)])
forall (t :: Type -> Type) 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)

-- | Calculate the beginning and end index into a variable, to get the
-- desired field.
-- Also returns the HWType of the result.
modifier
  :: HasCallStack
  => Range
  -- ^ Range selected so far
  -> Modifier
  -> Maybe (Range,HWType)
modifier :: 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

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

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

modifier Range
r (Indexed (CustomSP Text
_typName DataRepr'
_dataRepr Int
_size [(ConstrRepr', Text, [HWType])]
args,Int
dcI,Int
fI)) =
  (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy Range
r)
  where
    ses :: [(Int, Int)]
ses = Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. [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
      -- In case the second modifier is `Nothing` that means we want the entire
      -- thing calculated by the first modifier
      Maybe (Range, HWType)
Nothing -> (Range, HWType) -> Maybe (Range, HWType)
forall a. a -> Maybe a
Just (Range
r1,HWType
argTy)
      Maybe (Range, HWType)
m       -> Maybe (Range, HWType)
m

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

-- | Render a data constructor application for data constructors having a
-- custom bit representation.
customReprDataCon
  :: DataRepr'
  -- ^ Custom representation of data type
  -> ConstrRepr'
  -- ^ Custom representation of a specific constructor of @dataRepr@
  -> [(HWType, Expr)]
  -- ^ Arguments applied to constructor
  -> VerilogM Doc
customReprDataCon :: DataRepr'
-> ConstrRepr' -> [(HWType, Expr)] -> 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

-- | Turn a Netlist expression into a Verilog expression
expr_ :: Bool -- ^ Enclose in parentheses?
      -> Expr -- ^ Expr to convert
      -> 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)

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

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

-- See [Note] mask projection
expr_ Bool
_ (Identifier Identifier
_ (Just (Indexed ((BitVector Int
_),Int
_,Int
0)))) = do
  Int
iw <- State VerilogState Int -> Ap (State VerilogState) Int
forall k (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VerilogState Int -> Ap (State VerilogState) Int)
-> State VerilogState Int -> Ap (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Bool
-> 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
Signed Int
iw)

-- See [Note] bitvector projection
expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((BitVector Int
w),Int
_,Int
1)))) = do
  Int
iw <- State VerilogState Int -> Ap (State VerilogState) Int
forall k (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VerilogState Int -> Ap (State VerilogState) Int)
-> State VerilogState Int -> Ap (State VerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VerilogState Int -> State VerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VerilogState Int
Lens' VerilogState Int
intWidth
  Bool
-> 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
  = let NumLit Integer
m' = Literal
m
        NumLit Integer
i' = Literal
i
    in 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
  = let NumLit Integer
m' = Literal
m
        NumLit Integer
i' = Literal
i
    in 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) -- empty

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

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

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

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

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

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

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


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

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

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


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

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

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

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

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