sv2v-0.0.13: src/Convert/Interface.hs
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
-
- Conversion for interfaces
-}
module Convert.Interface (convert, disambiguate) where
import Data.List (intercalate, (\\))
import Data.Maybe (isJust, isNothing, mapMaybe)
import Data.Monoid (Any(Any), getAny)
import Control.Monad (when, (>=>))
import Control.Monad.Writer.Strict
import Text.Read (readMaybe)
import qualified Data.Map.Strict as Map
import Convert.ExprUtils (endianCondExpr)
import Convert.Scoper
import Convert.Traverse
import Language.SystemVerilog.AST
data PartInfo = PartInfo
{ pKind :: PartKW
, pPorts :: [Identifier]
, pItems :: [ModuleItem]
}
type PartInfos = Map.Map Identifier PartInfo
type ModportInstances = [(Identifier, (Identifier, Identifier))]
type ModportBinding = (Identifier, (Substitutions, Expr))
type Substitutions = [(Expr, Expr)]
convert :: [Identifier] -> [AST] -> [AST]
convert tops files =
if needsFlattening
then files
else traverseFiles
(collectDescriptionsM collectPart)
(map . convertDescription tops)
files
where
-- multidimensional instances need to be flattened before this
-- conversion can proceed
needsFlattening =
getAny $ execWriter $ mapM (collectDescriptionsM checkPart) files
checkPart :: Description -> Writer Any ()
checkPart (Part _ _ _ _ _ _ items) =
mapM (collectNestedModuleItemsM checkItem) items >> return ()
checkPart _ = return ()
checkItem :: ModuleItem -> Writer Any ()
checkItem (Instance _ _ _ rs _) = when (length rs > 1) $ tell $ Any True
checkItem _ = return ()
-- we can only collect/map non-extern interfaces and modules
collectPart :: Description -> Writer PartInfos ()
collectPart (Part _ False kw _ name ports items) =
tell $ Map.singleton name $ PartInfo kw ports items
collectPart _ = return ()
-- disambiguate typenames from interface names
disambiguate :: [AST] -> [AST]
disambiguate = traverseFiles
(collectDescriptionsM collectPart)
(map . disambiguateDescription)
-- disambiguate any typenames within a description
disambiguateDescription :: PartInfos -> Description -> Description
disambiguateDescription parts (Part att ext kw lif name ports items) =
Part att ext kw lif name ports $ map traverseModuleItem items
where
typeNames = getTypeNames items
traverseModuleItem :: ModuleItem -> ModuleItem
traverseModuleItem (MIAttr attr item) =
MIAttr attr $ traverseModuleItem item
traverseModuleItem (MIPackageItem (Decl (Variable d t x a e))) =
MIPackageItem $ Decl $ Variable d (traverseType t) x a e
traverseModuleItem other = other
traverseType :: Type -> Type
traverseType (Alias interfaceName rs) =
if isInterface interfaceName && not (elem interfaceName typeNames)
then InterfaceT interfaceName "" rs
else Alias interfaceName rs
traverseType orig@(InterfaceT interfaceName _ _) =
if null interfaceName || isInterface interfaceName
then orig
else error $ "declaration type " ++ show orig ++ " appears to "
++ "refer to an interface that isn't defined"
traverseType other = other
isInterface :: Identifier -> Bool
isInterface partName =
fmap pKind (Map.lookup partName parts) == Just Interface
disambiguateDescription _ other = other
-- get all of the typenames declared anywhere in the top-level module items
getTypeNames :: [ModuleItem] -> [Identifier]
getTypeNames (MIAttr _ item : rest) = getTypeNames $ item : rest
getTypeNames (Generate genItems : rest) =
getTypeNames $ genModuleItems genItems ++ rest
getTypeNames (MIPackageItem (Decl (ParamType _ name _)) : rest) =
name : getTypeNames rest
getTypeNames (_ : rest) = getTypeNames rest
getTypeNames [] = []
-- get the top-level (i.e., un-scoped) module items within a generate block
genModuleItems :: [GenItem] -> [ModuleItem]
genModuleItems (GenModuleItem item : rest) =
item : genModuleItems rest
genModuleItems (_ : rest) = genModuleItems rest
genModuleItems [] = []
topInterfaceError :: String -> String -> a
topInterfaceError name issue = error $
"Specified top module " ++ name ++ " " ++ issue ++ ". Please " ++
"instantiate it somewhere and use that as your top module instead."
convertDescription :: [Identifier] -> PartInfos -> Description -> Description
convertDescription tops _ (Part _ _ Interface _ name _ _)
| elem name tops =
topInterfaceError name "is an interface"
| otherwise =
PackageItem $ Decl $ CommentDecl $ "removed interface: " ++ name
convertDescription tops parts (Part att ext Module lif name ports items) =
if null $ extractModportInstances name $ PartInfo Module ports items then
Part att ext Module lif name ports items'
else if elem name tops then
topInterfaceError name "has interface ports"
else
PackageItem $ Decl $ CommentDecl $
"removed module with interface ports: " ++ name
where
items' = evalScoper $ scopeModuleItems scoper name items
scoper = scopeModuleItem traverseDeclM traverseModuleItemM return return
traverseDeclM :: Decl -> Scoper [ModportDecl] Decl
traverseDeclM decl = do
case decl of
Variable _ t x _ _ -> checkDeclType t x >> insertElem x DeclVal
Net _ _ _ t x _ _ -> checkDeclType t x >> insertElem x DeclVal
Param _ t x _ -> checkDeclType t x >> insertElem x DeclVal
ParamType _ x _ -> insertElem x DeclVal
CommentDecl{} -> return ()
return decl
-- check for module or interface names used as type names
checkDeclType :: Type -> Identifier -> Scoper a ()
checkDeclType (Alias typeName _) declName
| isNothing (readMaybe declName :: Maybe Int)
, Just part <- Map.lookup typeName parts = do
maybeType <- lookupElemM typeName
when (isNothing maybeType) $ scopedErrorM $
"declaration " ++ declName ++ " uses " ++ show (pKind part)
++ " name " ++ typeName ++ " where a type name is expected"
checkDeclType _ _ = return ()
lookupIntfElem :: Scopes [ModportDecl] -> Expr -> LookupResult [ModportDecl]
lookupIntfElem modports expr =
case lookupElem modports expr of
Just (_, _, DeclVal) -> Nothing
other -> other
traverseModuleItemM :: ModuleItem -> Scoper [ModportDecl] ModuleItem
traverseModuleItemM (Modport modportName modportDecls) =
insertElem modportName modportDecls >> return (Generate [])
traverseModuleItemM instanceItem@Instance{} = do
modports <- embedScopes (\l () -> l) ()
if isNothing maybePartInfo then
return instanceItem
else if partKind == Interface then
-- inline instantiation of an interface
scoper $ Generate $ map GenModuleItem $
inlineInstance modports rs []
partItems part instanceName paramBindings portBindings
else if null modportInstances then
return instanceItem
else do
-- inline instantiation of a module
let modportBindings = getModportBindings modports
let unconnected = map fst modportInstances \\
map fst modportBindings
if not (null unconnected)
then scopedErrorM $ "instance " ++ instanceName ++ " of "
++ part ++ " has unconnected interface ports: "
++ intercalate ", " unconnected
else scoper $ Generate $ map GenModuleItem $
inlineInstance modports rs modportBindings partItems
part instanceName paramBindings portBindings
where
Instance part paramBindings instanceName rs portBindings =
instanceItem
maybePartInfo = Map.lookup part parts
Just partInfo = maybePartInfo
PartInfo partKind _ partItems = partInfo
modportInstances = extractModportInstances part partInfo
getModportBindings modports = mapMaybe
(inferModportBinding modports modportInstances) $
map (second $ addImpliedSlice modports) portBindings
second f = \(a, b) -> (a, f b)
traverseModuleItemM other = return other
-- add explicit slices for bindings of entire modport instance arrays
addImpliedSlice :: Scopes [ModportDecl] -> Expr -> Expr
addImpliedSlice modports orig@(Dot expr modportName) =
case lookupIntfElem modports (InstArrKey expr) of
Just (_, _, InstArrVal l r) ->
Dot (Range expr NonIndexed (l, r)) modportName
_ -> orig
addImpliedSlice modports expr =
case lookupIntfElem modports (InstArrKey expr) of
Just (_, _, InstArrVal l r) ->
Range expr NonIndexed (l, r)
_ -> expr
-- elaborates and resolves provided modport bindings
inferModportBinding :: Scopes [ModportDecl] -> ModportInstances ->
PortBinding -> Maybe ModportBinding
inferModportBinding modports modportInstances (portName, expr) =
if maybeInfo == Nothing
then Nothing
else Just (portName, modportBinding)
where
modportBinding =
( substitutions
, scopeExprWithScopes modports $ replaceBit modportE
)
substitutions =
genSubstitutions modports base instanceE modportE
maybeInfo =
lookupModportBinding modports modportInstances portName bitd
Just (instanceE, modportE) = maybeInfo
(exprUndot, bitd) = case expr of
Dot subExpr x -> (subExpr, Dot bitdUndot x)
_ -> (expr, bitdUndot)
bitdUndot = case exprUndot of
Range subExpr _ _ -> Bit subExpr taggedOffset
Bit subExpr _ -> Bit subExpr untaggedOffset
_ -> exprUndot
bitReplacement = case exprUndot of
Range _ mode range -> \e -> Range e mode range
Bit _ idx -> flip Bit idx
_ -> id
base = case exprUndot of
Range{} -> Bit (Ident portName) Tag
_ -> Ident portName
untaggedOffset = Ident $ modportBaseName portName
taggedOffset = BinOp Add Tag untaggedOffset
replaceBit :: Expr -> Expr
replaceBit (Bit subExpr idx) =
if idx == untaggedOffset || idx == taggedOffset
then bitReplacement subExpr
else Bit subExpr idx
replaceBit (Dot subExpr x) =
Dot (replaceBit subExpr) x
replaceBit (Ident x) = Ident x
replaceBit _ = error "replaceBit invariant violated"
-- determines the underlying modport and interface instances associated
-- with the given port binding, if it is a modport binding
lookupModportBinding :: Scopes [ModportDecl] -> ModportInstances
-> Identifier -> Expr -> Maybe (Expr, Expr)
lookupModportBinding modports modportInstances portName expr =
if bindingIsModport then
-- provided specific instance modport
foundModport expr
else if bindingIsBundle && portIsBundle then
-- bundle bound to a generic bundle
foundModport expr
else if bindingIsBundle && not portIsBundle then
-- given entire interface, but just bound to a modport
foundModport $ Dot expr modportName
else if modportInstance /= Nothing then
scopedError modports $ "could not resolve modport binding "
++ show expr ++ " for port " ++ portName ++ " of type "
++ showModportType interfaceName modportName
else
Nothing
where
bindingIsModport = lookupIntfElem modports expr /= Nothing
bindingIsBundle = lookupIntfElem modports (Dot expr "") /= Nothing
portIsBundle = null modportName
modportInstance = lookup portName modportInstances
(interfaceName, modportName) =
case modportInstance of
Just x -> x
Nothing -> scopedError modports $
"can't deduce modport for interface " ++ show expr
++ " bound to port " ++ portName
foundModport modportE =
if (null interfaceName || bInterfaceName == interfaceName)
&& (null modportName || bModportName == modportName)
then Just (instanceE, qualifyModport modportE)
else scopedError modports msg
where
bModportName =
case modportE of
Dot _ x -> x
_ -> ""
instanceE = findInstance modportE
Just (_, _, InterfaceTypeVal bInterfaceName) =
lookupIntfElem modports $ InterfaceTypeKey
(findInstance modportE)
msg = "port " ++ portName ++ " has type "
++ showModportType interfaceName modportName
++ ", but the binding " ++ show expr ++ " has type "
++ showModportType bInterfaceName bModportName
findInstance :: Expr -> Expr
findInstance e =
case lookupIntfElem modports (Dot e "") of
Nothing -> case e of
Bit e' _ -> findInstance e'
Dot e' _ -> findInstance e'
_ -> error "internal invariant violated"
Just (accesses, _, _) -> accessesToExpr $ init accesses
qualifyModport :: Expr -> Expr
qualifyModport e =
accessesToExpr $
case lookupIntfElem modports e of
Just (accesses, _, _) -> accesses
Nothing ->
case lookupIntfElem modports (Dot e "") of
Just (accesses, _, _) -> init accesses
Nothing -> scopedError modports $
"could not find modport " ++ show e
showModportType :: Identifier -> Identifier -> String
showModportType "" "" = "generic interface"
showModportType intf "" = intf
showModportType intf modp = intf ++ '.' : modp
-- expand a modport binding into a series of expression substitutions
genSubstitutions :: Scopes [ModportDecl] -> Expr -> Expr -> Expr
-> [(Expr, Expr)]
genSubstitutions modports baseE instanceE modportE =
(baseE, instanceE) :
map toPortBinding modportDecls
where
a = lookupIntfElem modports modportE
b = lookupIntfElem modports (Dot modportE "")
Just (_, replacements, modportDecls) =
if a == Nothing then b else a
toPortBinding (_, x, e) = (x', e')
where
x' = Dot baseE x
e' = replaceInExpr replacements e
-- association list of modport instances in the given module body
extractModportInstances :: Identifier -> PartInfo -> ModportInstances
extractModportInstances part partInfo =
execWriter $ runScoperT $ scopeModuleItems collector part decls
where
collector = scopeModuleItem checkDecl return return return
decls = filter isDecl $ pItems partInfo
checkDecl :: Decl -> ScoperT () (Writer ModportInstances) Decl
checkDecl decl@(Variable _ t x _ _) =
if maybeInfo == Nothing then
return decl
else if elem x (pPorts partInfo) then
tell [(x, info)] >> return decl
else
scopedErrorM $
"Modport not in port list: " ++ show t ++ " " ++ x
++ ". Is this an interface missing a port list?"
where
maybeInfo = extractModportInfo t
Just info = maybeInfo
checkDecl decl = return decl
extractModportInfo :: Type -> Maybe (Identifier, Identifier)
extractModportInfo (InterfaceT interfaceName modportName _) =
Just (interfaceName, modportName)
extractModportInfo _ = Nothing
convertDescription _ _ other = other
isDecl :: ModuleItem -> Bool
isDecl (MIPackageItem Decl{}) = True
isDecl _ = False
-- produce the implicit modport decls for an interface bundle
impliedModport :: [ModuleItem] -> [ModportDecl]
impliedModport =
execWriter . mapM
(collectNestedModuleItemsM $ collectDeclsM collectModportDecls)
where
collectModportDecls :: Decl -> Writer [ModportDecl] ()
collectModportDecls (Variable _ _ x _ _) =
tell [(Inout, x, Ident x)]
collectModportDecls (Net _ _ _ _ x _ _) =
tell [(Inout, x, Ident x)]
collectModportDecls _ = return ()
-- convert an interface-bound module instantiation or an interface instantiation
-- into a series of equivalent inlined module items
inlineInstance :: Scopes [ModportDecl] -> [Range] -> [ModportBinding]
-> [ModuleItem] -> Identifier -> Identifier -> [ParamBinding]
-> [PortBinding] -> [ModuleItem]
inlineInstance global ranges modportBindings items partName
instanceName instanceParams instancePorts =
comment :
map (MIPackageItem . Decl) bindingBaseParams ++
map (MIPackageItem . Decl) parameterBinds ++
wrapInstance instanceName items'
: portBindings
where
items' = evalScoper $ scopeModuleItems scoper partName $
map (traverseNestedModuleItems rewriteItem) $
if null modportBindings
then itemsChecked ++ infoModports
else itemsChecked
itemsChecked = checkBeforeInline global partName items checkErrMsg
infoModports = [typeModport, dimensionModport, bundleModport]
scoper = scopeModuleItem
traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
key = shortHash (partName, instanceName, hierarchyPath global)
-- synthetic modports to be collected and removed after inlining
bundleModport = Modport "" (impliedModport items)
dimensionModport = if not isArray
then Generate []
else InstArrEncoded arrayLeft arrayRight
typeModport = InterfaceTypeEncoded partName
inlineKind =
if null modportBindings
then "interface"
else "module"
comment = MIPackageItem $ Decl $ CommentDecl $
"expanded " ++ inlineKind ++ " instance: " ++ instanceName
portBindings =
wrapPortBindings $
map portBindingItem $
filter ((/= Nil) . snd) $
filter notSubstituted instancePorts
notSubstituted :: PortBinding -> Bool
notSubstituted (portName, _) =
lookup portName modportBindings == Nothing
wrapPortBindings :: [ModuleItem] -> [ModuleItem]
wrapPortBindings =
if isArray
then (\x -> [x]) . wrapInstance blockName
else id
where blockName = instanceName ++ "_port_bindings"
rewriteItem :: ModuleItem -> ModuleItem
rewriteItem =
traverseDecls $
removeModportInstance .
removeDeclDir .
overrideParam
traverseDeclM :: Decl -> Scoper () Decl
traverseDeclM decl = do
case decl of
Variable _ _ x _ _ -> insertElem x ()
Net _ _ _ _ x _ _ -> insertElem x ()
Param _ _ x _ -> insertElem x ()
ParamType _ x _ -> insertElem x ()
CommentDecl{} -> return ()
traverseDeclExprsM traverseExprM decl
traverseModuleItemM :: ModuleItem -> Scoper () ModuleItem
traverseModuleItemM item@Modport{} =
traverseExprsM (scopeExpr >=> traverseExprM) item
traverseModuleItemM item@(Instance _ _ x _ _) =
insertElem x () >> traverseExprsM traverseExprM item
traverseModuleItemM item =
traverseExprsM traverseExprM item >>=
traverseLHSsM traverseLHSM
traverseGenItemM :: GenItem -> Scoper () GenItem
traverseGenItemM item@(GenFor (x, _) _ _ _) = do
-- don't want to be scoped in modports
insertElem x ()
item' <- traverseGenItemExprsM traverseExprM item
removeElem x
return item'
traverseGenItemM item =
traverseGenItemExprsM traverseExprM item
traverseStmtM :: Stmt -> Scoper () Stmt
traverseStmtM =
traverseStmtExprsM traverseExprM >=>
traverseStmtLHSsM traverseLHSM
-- used for replacing usages of modports in the module being inlined
modportSubstitutions = concatMap (fst . snd) modportBindings
lhsReplacements = map (\(x, y) -> (toLHS x, toLHS y)) exprReplacements
exprReplacements = filter ((/= Nil) . snd) modportSubstitutions
-- LHSs are replaced using simple substitutions
traverseLHSM :: LHS -> Scoper () LHS
traverseLHSM =
fmap replaceLHS .
embedScopes tagLHS
tagLHS :: Scopes () -> LHS -> LHS
tagLHS scopes lhs
| lookupElem scopes lhs /= Nothing =
LHSDot (renamePartLHS lhs) "@"
| Just portName <- partScopedModportRef $ lhsToExpr lhs =
LHSIdent portName
| otherwise =
traverseSinglyNestedLHSs (tagLHS scopes) lhs
renamePartLHS :: LHS -> LHS
renamePartLHS (LHSDot (LHSIdent x) y) =
if x == partName
then LHSDot scopedInstanceLHS y
else LHSDot (LHSIdent x) y
renamePartLHS lhs = traverseSinglyNestedLHSs renamePartLHS lhs
replaceLHS :: LHS -> LHS
replaceLHS (LHSDot lhs "@") = lhs
replaceLHS (LHSDot (LHSBit lhs elt) field) =
case lookup (LHSDot (LHSBit lhs Tag) field) lhsReplacements of
Just resolved -> replaceLHSArrTag elt resolved
Nothing -> LHSDot (replaceLHS $ LHSBit lhs elt) field
replaceLHS lhs =
case lookup lhs lhsReplacements of
Just lhs' -> lhs'
Nothing -> traverseSinglyNestedLHSs replaceLHS lhs
replaceLHSArrTag :: Expr -> LHS -> LHS
replaceLHSArrTag =
traverseNestedLHSs . (traverseLHSExprs . replaceArrTag)
-- top-level expressions may be modports bound to other modports
traverseExprM :: Expr -> Scoper () Expr
traverseExprM =
fmap replaceExpr .
embedScopes tagExpr
tagExpr :: Scopes () -> Expr -> Expr
tagExpr scopes expr
| lookupElem scopes expr /= Nothing =
Dot (renamePartExpr expr) "@"
| Just portName <- partScopedModportRef expr =
Ident portName
| otherwise =
visitExprsStep (tagExpr scopes) expr
renamePartExpr :: Expr -> Expr
renamePartExpr (Dot (Ident x) y) =
if x == partName
then Dot scopedInstanceExpr y
else Dot (Ident x) y
renamePartExpr expr = visitExprsStep renamePartExpr expr
replaceExpr :: Expr -> Expr
replaceExpr (Dot expr "@") = expr
replaceExpr (Ident x) =
case lookup x modportBindings of
Just (_, m) -> m
Nothing -> Ident x
replaceExpr expr =
replaceExpr' expr
replaceExpr' :: Expr -> Expr
replaceExpr' (Dot expr "@") = expr
replaceExpr' (Dot (Bit expr elt) field) =
case lookup (Dot (Bit expr Tag) field) exprReplacements of
Just resolved -> replaceArrTag (replaceExpr' elt) resolved
Nothing -> Dot (replaceExpr' $ Bit expr elt) field
replaceExpr' (Bit expr elt) =
case lookup (Bit expr Tag) exprReplacements of
Just resolved -> replaceArrTag (replaceExpr' elt) resolved
Nothing -> Bit (replaceExpr' expr) (replaceExpr' elt)
replaceExpr' expr@(Dot Ident{} _) =
case lookup expr exprReplacements of
Just expr' -> expr'
Nothing -> visitExprsStep replaceExprAny expr
replaceExpr' (Ident x) = Ident x
replaceExpr' expr = replaceExprAny expr
replaceExprAny :: Expr -> Expr
replaceExprAny expr =
case lookup expr exprReplacements of
Just expr' -> expr'
Nothing -> visitExprsStep replaceExpr' expr
replaceArrTag :: Expr -> Expr -> Expr
replaceArrTag replacement Tag = replacement
replaceArrTag replacement expr =
visitExprsStep (replaceArrTag replacement) expr
partScopedModportRef :: Expr -> Maybe Identifier
partScopedModportRef (Dot (Ident x) y) =
if x == partName && lookup y modportBindings /= Nothing
then Just y
else Nothing
partScopedModportRef _ = Nothing
visitExprsStep :: (Expr -> Expr) -> Expr -> Expr
visitExprsStep exprMapper =
traverseSinglyNestedExprs exprMapper
. traverseExprTypes (traverseNestedTypes typeMapper)
where typeMapper = traverseTypeExprs exprMapper
checkErrMsg :: String -> String
checkErrMsg exprStr = "inlining instance \"" ++ instanceName
++ "\" of " ++ inlineKind ++ " \"" ++ partName
++ "\" would make expression \"" ++ exprStr ++ "\" used in \""
++ instanceName ++ "\" resolvable when it wasn't previously"
-- unambiguous reference to the current instance
scopedInstanceRaw = accessesToExpr $ localAccesses global instanceName
scopedInstanceExpr =
if isArray
then Bit scopedInstanceRaw (Ident loopVar)
else scopedInstanceRaw
Just scopedInstanceLHS = exprToLHS scopedInstanceExpr
removeModportInstance :: Decl -> Decl
removeModportInstance (Variable d t x a e) =
if maybeModportBinding == Nothing then
Variable d t x a e
else if makeBindingBaseExpr modportE == Nothing then
CommentDecl $ "removed modport instance " ++ x
else if null modportDims then
localparam (modportBaseName x) bindingBaseExpr
else
localparam (modportBaseName x) $
BinOp Sub bindingBaseExpr (sliceLo NonIndexed modportDim)
where
maybeModportBinding = lookup x modportBindings
Just (_, modportE) = maybeModportBinding
bindingBaseExpr = Ident $ bindingBaseName ++ x
modportDims = a ++ snd (typeRanges t)
[modportDim] = modportDims
removeModportInstance other = other
removeDeclDir :: Decl -> Decl
removeDeclDir (Variable _ t x a e) =
Variable Local t' x a e'
where
t' = case t of
Implicit sg rs -> IntegerVector TLogic sg rs
_ -> t
e' = if isNothing (lookup x instancePorts)
then e
else Nil
removeDeclDir decl@Net{} =
traverseNetAsVar removeDeclDir decl
removeDeclDir other = other
-- capture the lower bound for each modport array binding
bindingBaseParams = mapMaybe makeBindingBaseParam modportBindings
makeBindingBaseParam :: ModportBinding -> Maybe Decl
makeBindingBaseParam (portName, (_, modportE)) =
fmap (localparam $ bindingBaseName ++ portName) $
makeBindingBaseExpr modportE
bindingBaseName = "_bbase_" ++ key ++ "_"
makeBindingBaseExpr :: Expr -> Maybe Expr
makeBindingBaseExpr modportE =
case modportE of
Dot (Range _ mode range) _ -> Just $ sliceLo mode range
Range _ mode range -> Just $ sliceLo mode range
Dot (Bit _ idx) _ -> Just idx
Bit _ idx -> Just idx
_ -> Nothing
localparam :: Identifier -> Expr -> Decl
localparam = Param Localparam (Implicit Unspecified [])
paramTmp = "_param_" ++ key ++ "_"
parameterBinds = map makeParameterBind instanceParams
makeParameterBind :: ParamBinding -> Decl
makeParameterBind (x, Left t) =
ParamType Localparam (paramTmp ++ x) t
makeParameterBind (x, Right e) =
Param Localparam UnknownType (paramTmp ++ x) e
overrideParam :: Decl -> Decl
overrideParam (Param Parameter t x e) =
Param Localparam t x $
case lookup x instanceParams of
Nothing -> e
Just _ -> Ident $ paramTmp ++ x
overrideParam (ParamType Parameter x t) =
ParamType Localparam x $
case lookup x instanceParams of
Nothing -> t
Just _ -> Alias (paramTmp ++ x) []
overrideParam other = other
portBindingItem :: PortBinding -> ModuleItem
portBindingItem (ident, expr) =
if findDeclDir ident == Input
then bind (LHSDot (inj LHSBit LHSIdent) ident) expr
else bind (toLHS expr) (Dot (inj Bit Ident) ident)
where
bind = Assign AssignOptionNone
inj bit idn = if null ranges
then idn instanceName
else bit (idn instanceName) (Ident loopVar)
declDirs = execWriter $ mapM
(collectNestedModuleItemsM $ collectDeclsM collectDeclDir) items
collectDeclDir :: Decl -> Writer (Map.Map Identifier Direction) ()
collectDeclDir (Variable dir _ ident _ _) =
when (dir /= Local) $
tell $ Map.singleton ident dir
collectDeclDir net@Net{} =
collectNetAsVarM collectDeclDir net
collectDeclDir _ = return ()
findDeclDir :: Identifier -> Direction
findDeclDir ident =
case Map.lookup ident declDirs of
Nothing -> error $ "could not find decl dir of " ++ ident
++ " among " ++ show declDirs
Just dir -> dir
toLHS :: Expr -> LHS
toLHS expr =
case exprToLHS expr of
Just lhs -> lhs
Nothing -> error $ "trying to bind an " ++ inlineKind
++ " output to " ++ show expr ++ " but that can't be an LHS"
-- for instance arrays, a unique identifier to be used as a genvar
loopVar = "_arr_" ++ key
isArray = not $ null ranges
[arrayRange@(arrayLeft, arrayRight)] = ranges
-- wrap the given item in a generate loop if necessary
wrapInstance :: Identifier -> [ModuleItem] -> ModuleItem
wrapInstance blockName moduleItems =
Generate $
if not isArray then
[item]
else
[ GenModuleItem (Genvar loopVar)
, GenFor inits cond incr item
]
where
item = GenBlock blockName $ map GenModuleItem moduleItems
inits = (loopVar, arrayLeft)
cond = endianCondExpr arrayRange
(BinOp Ge (Ident loopVar) arrayRight)
(BinOp Le (Ident loopVar) arrayRight)
incr = (loopVar, AsgnOp Add, step)
step = endianCondExpr arrayRange
(UniOp UniSub $ RawNum 1) (RawNum 1)
-- used for modport array binding offset placeholders
pattern Tag :: Expr
pattern Tag = Ident "%"
modportBaseName :: Identifier -> Identifier
modportBaseName = (++) "_mbase_"
-- the dimensions of interface instance arrays are encoded as synthetic modports
-- during inlining, enabling subsequent modport bindings to implicitly use the
-- bounds of the interface instance array when the bounds are unspecified
pattern InstArrName :: Identifier
pattern InstArrName = "~instance_array_dimensions~"
pattern InstArrVal :: Expr -> Expr -> [ModportDecl]
pattern InstArrVal l r = [(Local, "l", l), (Local, "r", r)]
pattern InstArrKey :: Expr -> Expr
pattern InstArrKey expr = Dot (Bit expr (RawNum 0)) InstArrName
pattern InstArrEncoded :: Expr -> Expr -> ModuleItem
pattern InstArrEncoded l r = Modport InstArrName (InstArrVal l r)
-- encoding for normal declarations in the current module
pattern DeclVal :: [ModportDecl]
pattern DeclVal = [(Local, "~decl~", Nil)]
-- encoding for the interface type of an interface instantiation
pattern InterfaceTypeName :: Identifier
pattern InterfaceTypeName = "~interface_type~"
pattern InterfaceTypeVal :: Identifier -> [ModportDecl]
pattern InterfaceTypeVal x = [(Local, "~interface~type~", Ident x)]
pattern InterfaceTypeKey :: Expr -> Expr
pattern InterfaceTypeKey e = Dot e InterfaceTypeName
pattern InterfaceTypeEncoded :: Identifier -> ModuleItem
pattern InterfaceTypeEncoded x = Modport InterfaceTypeName (InterfaceTypeVal x)
-- determines the lower bound for the given slice
sliceLo :: PartSelectMode -> Range -> Expr
sliceLo NonIndexed (l, r) = endianCondExpr (l, r) r l
sliceLo IndexedPlus (base, _) = base
sliceLo IndexedMinus (base, len) = BinOp Add (BinOp Sub base len) (RawNum 1)
-- check for cases where an expression in an inlined part only resolves after
-- inlining, potentially hiding a design error
checkBeforeInline :: Scopes a -> Identifier -> [ModuleItem]
-> (String -> String) -> [ModuleItem]
checkBeforeInline global partName items checkErrMsg =
evalScoper $ scopeModuleItems scoper partName $ items
where
scoper = scopeModuleItem
checkDecl checkModuleItem checkGenItem checkStmt
checkDecl :: Decl -> Scoper () Decl
checkDecl decl = do
case decl of
Variable _ _ x _ _ -> insertElem x ()
Net _ _ _ _ x _ _ -> insertElem x ()
Param _ _ x _ -> insertElem x ()
ParamType _ x _ -> insertElem x ()
CommentDecl{} -> return ()
traverseDeclExprsM checkExpr decl
checkModuleItem :: ModuleItem -> Scoper () ModuleItem
checkModuleItem item@(Instance _ _ x _ _) =
insertElem x () >> traverseExprsM checkExpr item
checkModuleItem item =
traverseExprsM checkExpr item >>=
traverseLHSsM checkLHS
checkGenItem :: GenItem -> Scoper () GenItem
checkGenItem = traverseGenItemExprsM checkExpr
checkStmt :: Stmt -> Scoper () Stmt
checkStmt =
traverseStmtExprsM checkExpr >=>
traverseStmtLHSsM checkLHS
checkExpr :: Expr -> Scoper () Expr
checkExpr = embedScopes checkExprResolutionId
checkLHS :: LHS -> Scoper () LHS
checkLHS = embedScopes checkLHSResolutionId
checkLHSResolutionId :: Scopes () -> LHS -> LHS
checkLHSResolutionId local lhs = checkExprResolution local expr lhs
where expr = lhsToExpr lhs
checkExprResolutionId :: Scopes () -> Expr -> Expr
checkExprResolutionId local expr = checkExprResolution local expr expr
-- error if the given expression resolves globally but not locally
checkExprResolution :: Scopes () -> Expr -> a -> a
checkExprResolution local expr =
if exprResolves global expr && not (anyPrefixResolves local expr)
then scopedError local $ checkErrMsg $ show expr
else id
-- check if hierarchical prefix of an expr exists in the given scope
anyPrefixResolves :: Scopes () -> Expr -> Bool
anyPrefixResolves local expr =
exprResolves local expr ||
case expr of
Dot inner _ -> anyPrefixResolves local inner
Bit inner _ -> anyPrefixResolves local inner
_ -> False
-- check if expr exists in the given scope
exprResolves :: Scopes a -> Expr -> Bool
exprResolves local (Ident x) =
isJust (lookupElem local x) || isLoopVar local x
exprResolves local expr =
isJust (lookupElem local expr)