{- sv2v - Author: Zachary Snow - - Conversion for interfaces -} module Convert.Interface (convert, disambiguate) where import Data.List (intercalate, (\\)) import Data.Maybe (isJust, isNothing, mapMaybe) 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) -- 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 Unspecified rs -> IntegerVector TLogic Unspecified rs _ -> t 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 (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)