sv2v/src/Convert/Interface.hs

704 lines
31 KiB
Haskell
Raw Normal View History

{-# LANGUAGE PatternSynonyms #-}
2019-03-07 02:30:47 +01:00
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
-
- Conversion for interfaces
-}
module Convert.Interface (convert) where
import Data.Maybe (isJust, isNothing, mapMaybe)
2020-08-12 01:14:18 +02:00
import Control.Monad.Writer.Strict
2019-03-07 02:30:47 +01:00
import qualified Data.Map.Strict as Map
import Convert.ExprUtils (endianCondExpr)
import Convert.Scoper
2019-03-07 02:30:47 +01:00
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)]
2019-03-07 02:30:47 +01:00
convert :: [AST] -> [AST]
convert files =
if needsFlattening
then files
else traverseFiles
(collectDescriptionsM collectPart)
(map . convertDescription)
files
2019-03-07 02:30:47 +01:00
where
-- 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 ()
-- 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 ()
convertDescription :: PartInfos -> Description -> Description
convertDescription _ (Part _ _ Interface _ name _ _) =
PackageItem $ Decl $ CommentDecl $ "removed interface: " ++ name
convertDescription parts (Part attrs extern Module lifetime name ports items) =
if null $ extractModportInstances $ PartInfo Module ports items then
Part attrs extern Module lifetime name ports items'
else
PackageItem $ Decl $ CommentDecl $
"removed module with interface ports: " ++ name
2019-03-07 02:30:47 +01:00
where
items' = evalScoper
traverseDeclM traverseModuleItemM return return name items
convertNested =
scopeModuleItemT traverseDeclM traverseModuleItemM return return
traverseDeclM :: Decl -> Scoper [ModportDecl] Decl
traverseDeclM decl = do
case decl of
Variable _ _ x _ _ -> insertElem x DeclVal
Net _ _ _ _ x _ _ -> insertElem x DeclVal
Param _ _ x _ -> insertElem x DeclVal
ParamType _ x _ -> insertElem x DeclVal
CommentDecl{} -> return ()
return decl
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
convertNested $ 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
if length modportInstances /= length modportBindings
then
error $ "instance " ++ instanceName ++ " of " ++ part
++ " has interface ports "
++ showKeys modportInstances ++ ", but only "
++ showKeys modportBindings ++ " are connected"
else convertNested $ Generate $ map GenModuleItem $
inlineInstance modports rs modportBindings partItems
part instanceName paramBindings portBindings
2020-06-20 20:39:57 +02:00
where
Instance part paramBindings instanceName rs portBindings =
instanceItem
maybePartInfo = Map.lookup part parts
Just partInfo = maybePartInfo
PartInfo partKind _ partItems = partInfo
modportInstances = extractModportInstances partInfo
getModportBindings modports = mapMaybe
(inferModportBinding modports modportInstances) $
map (second $ addImpliedSlice modports) portBindings
second f = \(a, b) -> (a, f b)
showKeys = show . map fst
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, 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
error $ "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 -> error $ "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 error 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 ->
error $ "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
2019-10-21 04:06:10 +02:00
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 :: PartInfo -> ModportInstances
extractModportInstances partInfo =
execWriter $ mapM (collectDeclsM collectDecl) (pItems partInfo)
where
collectDecl :: Decl -> Writer ModportInstances ()
collectDecl (Variable _ t x _ _) =
if maybeInfo == Nothing then
return ()
else if elem x (pPorts partInfo) then
tell [(x, info)]
else
error $ "Modport not in port list: " ++ show (t, x)
++ ". Is this an interface missing a port list?"
2020-06-20 20:39:57 +02:00
where
maybeInfo = extractModportInfo t
Just info = maybeInfo
collectDecl _ = return ()
2019-03-07 02:30:47 +01:00
extractModportInfo :: Type -> Maybe (Identifier, Identifier)
2021-06-02 21:25:02 +02:00
extractModportInfo (InterfaceT "" "" _) = Just ("", "")
extractModportInfo (InterfaceT interfaceName modportName _) =
if isInterface interfaceName
then Just (interfaceName, modportName)
else Nothing
2021-06-02 21:25:02 +02:00
extractModportInfo (Alias interfaceName _) =
if isInterface interfaceName
then Just (interfaceName, "")
else Nothing
extractModportInfo _ = Nothing
isInterface :: Identifier -> Bool
isInterface partName =
case Map.lookup partName parts of
Nothing -> False
Just info -> pKind info == Interface
convertDescription _ other = other
-- 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 traverseDeclM traverseModuleItemM traverseGenItemM
traverseStmtM partName $
map (traverseNestedModuleItems rewriteItem) $
if null modportBindings
then items ++ [typeModport, dimensionModport, bundleModport]
else items
key = shortHash (partName, instanceName)
-- 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 =
embedScopes tagLHS >=>
embedScopes replaceLHS
tagLHS :: Scopes () -> LHS -> LHS
tagLHS scopes lhs =
if lookupElem scopes lhs /= Nothing
then LHSDot (renamePartLHS lhs) "@"
else 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 :: Scopes () -> LHS -> LHS
replaceLHS _ (LHSDot lhs "@") = lhs
replaceLHS local (LHSDot (LHSBit lhs elt) field) =
case lookup (LHSDot (LHSBit lhs Tag) field) lhsReplacements of
Just resolved -> replaceLHSArrTag elt resolved
Nothing -> LHSDot (replaceLHS local $ LHSBit lhs elt) field
replaceLHS local lhs =
case lookup lhs lhsReplacements of
Just lhs' -> lhs'
Nothing -> checkExprResolution local (lhsToExpr lhs) $
traverseSinglyNestedLHSs (replaceLHS local) lhs
replaceLHSArrTag :: Expr -> LHS -> LHS
replaceLHSArrTag =
traverseNestedLHSs . (traverseLHSExprs . replaceArrTag)
-- top-level expressions may be modports bound to other modports
traverseExprM :: Expr -> Scoper () Expr
traverseExprM =
embedScopes tagExpr >=>
embedScopes replaceExpr
tagExpr :: Scopes () -> Expr -> Expr
tagExpr scopes expr =
if lookupElem scopes expr /= Nothing
then Dot (renamePartExpr expr) "@"
else traverseSinglyNestedExprs (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 = traverseSinglyNestedExprs renamePartExpr expr
replaceExpr :: Scopes () -> Expr -> Expr
replaceExpr _ (Dot expr "@") = expr
replaceExpr local (Ident x) =
case lookup x modportBindings of
Just (_, m) -> m
Nothing -> checkExprResolution local (Ident x) (Ident x)
replaceExpr local expr =
replaceExpr' local expr
replaceExpr' :: Scopes () -> Expr -> Expr
replaceExpr' _ (Dot expr "@") = expr
replaceExpr' local (Dot (Bit expr elt) field) =
case lookup (Dot (Bit expr Tag) field) exprReplacements of
Just resolved -> replaceArrTag (replaceExpr' local elt) resolved
Nothing -> Dot (replaceExpr' local $ Bit expr elt) field
replaceExpr' local (Bit expr elt) =
case lookup (Bit expr Tag) exprReplacements of
Just resolved -> replaceArrTag (replaceExpr' local elt) resolved
Nothing -> Bit (replaceExpr' local expr) (replaceExpr' local elt)
replaceExpr' local expr@(Dot Ident{} _) =
case lookup expr exprReplacements of
Just expr' -> expr'
Nothing -> checkExprResolution local expr $
traverseSinglyNestedExprs (replaceExprAny local) expr
replaceExpr' local (Ident x) =
checkExprResolution local (Ident x) (Ident x)
replaceExpr' local expr = replaceExprAny local expr
replaceExprAny :: Scopes () -> Expr -> Expr
replaceExprAny local expr =
case lookup expr exprReplacements of
Just expr' -> expr'
Nothing -> checkExprResolution local expr $
traverseSinglyNestedExprs (replaceExpr' local) expr
replaceArrTag :: Expr -> Expr -> Expr
replaceArrTag replacement Tag = replacement
replaceArrTag replacement expr =
traverseSinglyNestedExprs (replaceArrTag replacement) expr
checkExprResolution :: Scopes () -> Expr -> a -> a
checkExprResolution local expr =
if not (exprResolves local expr) && exprResolves global expr
then
error $ "inlining instance \"" ++ instanceName ++ "\" of "
++ inlineKind ++ " \"" ++ partName
++ "\" would make expression \"" ++ show expr
++ "\" used in \"" ++ instanceName
++ "\" resolvable when it wasn't previously"
else id
exprResolves :: Scopes a -> Expr -> Bool
exprResolves local (Ident x) =
isJust (lookupElem local x) || isLoopVar local x
exprResolves local expr =
isJust (lookupElem local expr)
-- 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
2021-06-02 21:25:02 +02:00
else if null modportDims then
localparam (modportBaseName x) bindingBaseExpr
else
localparam (modportBaseName x) $
2021-06-02 21:25:02 +02:00
BinOp Sub bindingBaseExpr (sliceLo NonIndexed modportDim)
where
maybeModportBinding = lookup x modportBindings
Just (_, modportE) = maybeModportBinding
bindingBaseExpr = Ident $ bindingBaseName ++ x
2021-06-02 21:25:02 +02:00
modportDims = a ++ snd (typeRanges t)
[modportDim] = modportDims
removeModportInstance other = other
2019-03-07 02:30:47 +01:00
removeDeclDir :: Decl -> Decl
removeDeclDir (Variable _ t x a e) =
Variable Local t' x a e
where t' = case t of
Implicit Unspecified rs ->
IntegerVector TLogic Unspecified rs
_ -> t
removeDeclDir decl@Net{} =
traverseNetAsVar removeDeclDir decl
2019-04-23 23:12:56 +02:00
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) =
case lookup x instanceParams of
Nothing -> Param Localparam t x e
Just (Right _) -> Param Localparam t x (Ident $ paramTmp ++ x)
Just (Left t') -> error $ inlineKind ++ " param " ++ x
++ " expected expr, found type: " ++ show t'
overrideParam (ParamType Parameter x t) =
case lookup x instanceParams of
Nothing -> ParamType Localparam x t
Just (Left _) ->
ParamType Localparam x $ Alias (paramTmp ++ x) []
Just (Right e') -> error $ inlineKind ++ " param " ++ x
++ " expected type, found expr: " ++ show e'
overrideParam other = other
portBindingItem :: PortBinding -> ModuleItem
2020-06-14 21:56:09 +02:00
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 (collectDeclsM collectDeclDir) items
collectDeclDir :: Decl -> Writer (Map.Map Identifier Direction) ()
collectDeclDir (Variable dir _ ident _ _) =
2020-06-20 22:41:13 +02:00
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)