From 86195d9ea1f44135f5a23c5a3ada0b7b276dc662 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Tue, 2 Apr 2019 13:33:18 -0400 Subject: [PATCH] interface conversion obeys function/task identifier shadowing --- src/Convert/Interface.hs | 46 ++++++++---- src/Convert/Traverse.hs | 147 ++++++++++++++++++++++++++++++--------- 2 files changed, 146 insertions(+), 47 deletions(-) diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs index 560ded1..a8911ea 100644 --- a/src/Convert/Interface.hs +++ b/src/Convert/Interface.hs @@ -9,6 +9,7 @@ module Convert.Interface (convert) where import Data.Maybe (isJust, mapMaybe) import Control.Monad.Writer import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import Convert.Traverse import Language.SystemVerilog.AST @@ -47,8 +48,8 @@ convertDescription interfaces modules (Part extern Module lifetime name ports it Part extern Module lifetime name ports' items' where items' = - map (traverseNestedModuleItems $ traverseExprs (traverseNestedExprs convertExpr)) $ - map (traverseNestedModuleItems $ traverseLHSs (traverseNestedLHSs convertLHS)) $ + map (traverseNestedModuleItems $ traverseExprs' ExcludeTFs (traverseNestedExprs $ convertExpr instances modports)) $ + map (traverseNestedModuleItems $ traverseLHSs' ExcludeTFs (traverseNestedLHSs $ convertLHS instances modports)) $ map (traverseNestedModuleItems mapInterface) $ items ports' = concatMap convertPort ports @@ -89,8 +90,25 @@ convertDescription interfaces modules (Part extern Module lifetime name ports it inlineInterface interface (ident, expandedPorts) Nothing -> Instance part params ident Nothing expandedPorts where expandedPorts = concatMap (expandPortBinding part) instancePorts + mapInterface (orig @ (MIPackageItem (Function _ _ _ decls _))) = + convertTF decls orig + mapInterface (orig @ (MIPackageItem (Task _ _ decls _))) = + convertTF decls orig mapInterface other = other + convertTF :: [Decl] -> ModuleItem -> ModuleItem + convertTF decls orig = + traverseExprs (traverseNestedExprs $ convertExpr its mps) $ + traverseLHSs (traverseNestedLHSs $ convertLHS its mps) $ + orig + where + locals = Set.fromList $ mapMaybe declVarIdent decls + its = Map.withoutKeys instances locals + mps = Map.withoutKeys modports locals + declVarIdent :: Decl -> Maybe Identifier + declVarIdent (Variable _ _ x _ _) = Just x + declVarIdent _ = Nothing + expandPortBinding :: Identifier -> PortBinding -> [PortBinding] expandPortBinding _ (origBinding @ (portName, Just (Dot (Ident instanceName) modportName))) = case Map.lookup instanceName instances of @@ -136,22 +154,22 @@ convertDescription interfaces modules (Part extern Module lifetime name ports it collectModport (Modport ident l) = tell $ Map.singleton ident l collectModport _ = return () - convertExpr :: Expr -> Expr - convertExpr (orig @ (Dot (Ident x) y)) = - if Map.member x modports || Map.member x instances + convertExpr :: Instances -> Modports -> Expr -> Expr + convertExpr its mps (orig @ (Dot (Ident x) y)) = + if Map.member x mps || Map.member x its then Ident (x ++ "_" ++ y) else orig - convertExpr other = other - convertLHS :: LHS -> LHS - convertLHS (orig @ (LHSDot (LHSIdent x) y)) = - if Map.member x modports || Map.member x instances + convertExpr _ _ other = other + convertLHS :: Instances -> Modports -> LHS -> LHS + convertLHS its mps (orig @ (LHSDot (LHSIdent x) y)) = + if Map.member x mps || Map.member x its then LHSIdent (x ++ "_" ++ y) else orig - convertLHS (LHSBit l e) = - LHSBit l (traverseNestedExprs convertExpr e) - convertLHS (LHSRange l (e1, e2)) = - LHSRange l (traverseNestedExprs convertExpr e1, traverseNestedExprs convertExpr e2) - convertLHS other = other + convertLHS its mps (LHSBit l e) = + LHSBit l (traverseNestedExprs (convertExpr its mps) e) + convertLHS its mps (LHSRange l (e1, e2)) = + LHSRange l (traverseNestedExprs (convertExpr its mps) e1, traverseNestedExprs (convertExpr its mps) e2) + convertLHS _ _ other = other convertPort :: Identifier -> [Identifier] convertPort ident = case Map.lookup ident modports of diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 6825828..3c46260 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -7,6 +7,8 @@ module Convert.Traverse ( MapperM , Mapper +, CollectorM +, TFStrategy (..) , unmonad , collectify , traverseDescriptionsM @@ -18,18 +20,30 @@ module Convert.Traverse , traverseStmtsM , traverseStmts , collectStmtsM +, traverseStmtsM' +, traverseStmts' +, collectStmtsM' , traverseStmtLHSsM , traverseStmtLHSs , collectStmtLHSsM , traverseExprsM , traverseExprs , collectExprsM +, traverseExprsM' +, traverseExprs' +, collectExprsM' , traverseLHSsM , traverseLHSs , collectLHSsM +, traverseLHSsM' +, traverseLHSs' +, collectLHSsM' , traverseDeclsM , traverseDecls , collectDeclsM +, traverseDeclsM' +, traverseDecls' +, collectDeclsM' , traverseTypesM , traverseTypes , collectTypesM @@ -39,6 +53,9 @@ module Convert.Traverse , traverseAsgnsM , traverseAsgns , collectAsgnsM +, traverseAsgnsM' +, traverseAsgns' +, collectAsgnsM' , traverseNestedModuleItemsM , traverseNestedModuleItems , collectNestedModuleItemsM @@ -57,6 +74,11 @@ type MapperM m t = t -> m t type Mapper t = t -> t type CollectorM m t = t -> m () +data TFStrategy + = IncludeTFs + | ExcludeTFs + deriving Eq + unmonad :: (MapperM (State ()) a -> MapperM (State ()) b) -> Mapper a -> Mapper b unmonad traverser mapper thing = evalState (traverser (return . mapper) thing) () @@ -107,26 +129,39 @@ traverseModuleItems = unmonad traverseModuleItemsM collectModuleItemsM :: Monad m => CollectorM m ModuleItem -> CollectorM m Description collectModuleItemsM = collectify traverseModuleItemsM -traverseStmtsM :: Monad m => MapperM m Stmt -> MapperM m ModuleItem -traverseStmtsM mapper = moduleItemMapper +traverseStmtsM' :: Monad m => TFStrategy -> MapperM m Stmt -> MapperM m ModuleItem +traverseStmtsM' strat mapper = moduleItemMapper where moduleItemMapper (AlwaysC kw stmt) = fullMapper stmt >>= return . AlwaysC kw moduleItemMapper (MIPackageItem (Function lifetime ret name decls stmts)) = do - stmts' <- mapM fullMapper stmts + stmts' <- + if strat == IncludeTFs + then mapM fullMapper stmts + else return stmts return $ MIPackageItem $ Function lifetime ret name decls stmts' moduleItemMapper (MIPackageItem (Task lifetime name decls stmts)) = do - stmts' <- mapM fullMapper stmts + stmts' <- + if strat == IncludeTFs + then mapM fullMapper stmts + else return stmts return $ MIPackageItem $ Task lifetime name decls stmts' moduleItemMapper (Initial stmt) = fullMapper stmt >>= return . Initial moduleItemMapper other = return $ other fullMapper = traverseNestedStmtsM mapper +traverseStmts' :: TFStrategy -> Mapper Stmt -> Mapper ModuleItem +traverseStmts' strat = unmonad $ traverseStmtsM' strat +collectStmtsM' :: Monad m => TFStrategy -> CollectorM m Stmt -> CollectorM m ModuleItem +collectStmtsM' strat = collectify $ traverseStmtsM' strat + +traverseStmtsM :: Monad m => MapperM m Stmt -> MapperM m ModuleItem +traverseStmtsM = traverseStmtsM' IncludeTFs traverseStmts :: Mapper Stmt -> Mapper ModuleItem -traverseStmts = unmonad traverseStmtsM +traverseStmts = traverseStmts' IncludeTFs collectStmtsM :: Monad m => CollectorM m Stmt -> CollectorM m ModuleItem -collectStmtsM = collectify traverseStmtsM +collectStmtsM = collectStmtsM' IncludeTFs -- private utility for turning a thing which maps over a single lever of -- statements into one that maps over the nested statements first, then the @@ -246,8 +281,8 @@ traverseNestedExprsM mapper = exprMapper return $ Pattern $ zip names exprs -traverseExprsM :: Monad m => MapperM m Expr -> MapperM m ModuleItem -traverseExprsM mapper = moduleItemMapper +traverseExprsM' :: Monad m => TFStrategy -> MapperM m Expr -> MapperM m ModuleItem +traverseExprsM' strat mapper = moduleItemMapper where rangeMapper (a, b) = do @@ -337,12 +372,24 @@ traverseExprsM mapper = moduleItemMapper expr' <- exprMapper expr return $ Assign delay' lhs expr' moduleItemMapper (MIPackageItem (Function lifetime ret f decls stmts)) = do - decls' <- mapM declMapper decls - stmts' <- mapM stmtMapper stmts + decls' <- + if strat == IncludeTFs + then mapM declMapper decls + else return decls + stmts' <- + if strat == IncludeTFs + then mapM stmtMapper stmts + else return stmts return $ MIPackageItem $ Function lifetime ret f decls' stmts' moduleItemMapper (MIPackageItem (Task lifetime f decls stmts)) = do - decls' <- mapM declMapper decls - stmts' <- mapM stmtMapper stmts + decls' <- + if strat == IncludeTFs + then mapM declMapper decls + else return decls + stmts' <- + if strat == IncludeTFs + then mapM stmtMapper stmts + else return stmts return $ MIPackageItem $ Task lifetime f decls' stmts' moduleItemMapper (Instance m p x r l) = do p' <- mapM portBindingMapper p @@ -385,14 +432,21 @@ traverseExprsM mapper = moduleItemMapper return (dir, ident, Just e') modportDeclMapper other = return other -traverseExprs :: Mapper Expr -> Mapper ModuleItem -traverseExprs = unmonad traverseExprsM -collectExprsM :: Monad m => CollectorM m Expr -> CollectorM m ModuleItem -collectExprsM = collectify traverseExprsM +traverseExprs' :: TFStrategy -> Mapper Expr -> Mapper ModuleItem +traverseExprs' strat = unmonad $ traverseExprsM' strat +collectExprsM' :: Monad m => TFStrategy -> CollectorM m Expr -> CollectorM m ModuleItem +collectExprsM' strat = collectify $ traverseExprsM' strat -traverseLHSsM :: Monad m => MapperM m LHS -> MapperM m ModuleItem -traverseLHSsM mapper item = - traverseStmtsM (traverseStmtLHSsM mapper) item >>= traverseModuleItemLHSsM +traverseExprsM :: Monad m => MapperM m Expr -> MapperM m ModuleItem +traverseExprsM = traverseExprsM' IncludeTFs +traverseExprs :: Mapper Expr -> Mapper ModuleItem +traverseExprs = traverseExprs' IncludeTFs +collectExprsM :: Monad m => CollectorM m Expr -> CollectorM m ModuleItem +collectExprsM = collectExprsM' IncludeTFs + +traverseLHSsM' :: Monad m => TFStrategy -> MapperM m LHS -> MapperM m ModuleItem +traverseLHSsM' strat mapper item = + traverseStmtsM' strat (traverseStmtLHSsM mapper) item >>= traverseModuleItemLHSsM where traverseModuleItemLHSsM (Assign delay lhs expr) = do lhs' <- mapper lhs @@ -408,10 +462,17 @@ traverseLHSsM mapper item = return $ NInputGate kw x lhs' exprs traverseModuleItemLHSsM other = return other +traverseLHSs' :: TFStrategy -> Mapper LHS -> Mapper ModuleItem +traverseLHSs' strat = unmonad $ traverseLHSsM' strat +collectLHSsM' :: Monad m => TFStrategy -> CollectorM m LHS -> CollectorM m ModuleItem +collectLHSsM' strat = collectify $ traverseLHSsM' strat + +traverseLHSsM :: Monad m => MapperM m LHS -> MapperM m ModuleItem +traverseLHSsM = traverseLHSsM' IncludeTFs traverseLHSs :: Mapper LHS -> Mapper ModuleItem -traverseLHSs = unmonad traverseLHSsM +traverseLHSs = traverseLHSs' IncludeTFs collectLHSsM :: Monad m => CollectorM m LHS -> CollectorM m ModuleItem -collectLHSsM = collectify traverseLHSsM +collectLHSsM = collectLHSsM' IncludeTFs traverseNestedLHSsM :: Monad m => MapperM m LHS -> MapperM m LHS traverseNestedLHSsM mapper = fullMapper @@ -428,18 +489,24 @@ traverseNestedLHSs = unmonad traverseNestedLHSsM collectNestedLHSsM :: Monad m => CollectorM m LHS -> CollectorM m LHS collectNestedLHSsM = collectify traverseNestedLHSsM -traverseDeclsM :: Monad m => MapperM m Decl -> MapperM m ModuleItem -traverseDeclsM mapper item = do +traverseDeclsM' :: Monad m => TFStrategy -> MapperM m Decl -> MapperM m ModuleItem +traverseDeclsM' strat mapper item = do item' <- miMapperA item - traverseStmtsM miMapperB item' + traverseStmtsM' strat miMapperB item' where miMapperA (MIDecl decl) = mapper decl >>= return . MIDecl miMapperA (MIPackageItem (Function l t x decls s)) = do - decls' <- mapM mapper decls + decls' <- + if strat == IncludeTFs + then mapM mapper decls + else return decls return $ MIPackageItem $ Function l t x decls' s miMapperA (MIPackageItem (Task l x decls s)) = do - decls' <- mapM mapper decls + decls' <- + if strat == IncludeTFs + then mapM mapper decls + else return decls return $ MIPackageItem $ Task l x decls' s miMapperA other = return other miMapperB (Block name decls stmts) = do @@ -447,10 +514,17 @@ traverseDeclsM mapper item = do return $ Block name decls' stmts miMapperB other = return other +traverseDecls' :: TFStrategy -> Mapper Decl -> Mapper ModuleItem +traverseDecls' strat = unmonad $ traverseDeclsM' strat +collectDeclsM' :: Monad m => TFStrategy -> CollectorM m Decl -> CollectorM m ModuleItem +collectDeclsM' strat = collectify $ traverseDeclsM' strat + +traverseDeclsM :: Monad m => MapperM m Decl -> MapperM m ModuleItem +traverseDeclsM = traverseDeclsM' IncludeTFs traverseDecls :: Mapper Decl -> Mapper ModuleItem -traverseDecls = unmonad traverseDeclsM +traverseDecls = traverseDecls' IncludeTFs collectDeclsM :: Monad m => CollectorM m Decl -> CollectorM m ModuleItem -collectDeclsM = collectify traverseDeclsM +collectDeclsM = collectDeclsM' IncludeTFs traverseTypesM :: Monad m => MapperM m Type -> MapperM m ModuleItem traverseTypesM mapper item = @@ -538,8 +612,8 @@ traverseNestedGenItemsM mapper = fullMapper flattenBlocks (GenBlock Nothing items) = items flattenBlocks other = [other] -traverseAsgnsM :: Monad m => MapperM m (LHS, Expr) -> MapperM m ModuleItem -traverseAsgnsM mapper = moduleItemMapper +traverseAsgnsM' :: Monad m => TFStrategy -> MapperM m (LHS, Expr) -> MapperM m ModuleItem +traverseAsgnsM' strat mapper = moduleItemMapper where moduleItemMapper item = miMapperA item >>= miMapperB @@ -551,7 +625,7 @@ traverseAsgnsM mapper = moduleItemMapper return $ Defparam lhs' expr' miMapperA other = return other - miMapperB = traverseStmtsM stmtMapper + miMapperB = traverseStmtsM' strat stmtMapper stmtMapper (AsgnBlk op lhs expr) = do (lhs', expr') <- mapper (lhs, expr) return $ AsgnBlk op lhs' expr' @@ -560,10 +634,17 @@ traverseAsgnsM mapper = moduleItemMapper return $ Asgn mt lhs' expr' stmtMapper other = return other +traverseAsgns' :: TFStrategy -> Mapper (LHS, Expr) -> Mapper ModuleItem +traverseAsgns' strat = unmonad $ traverseAsgnsM' strat +collectAsgnsM' :: Monad m => TFStrategy -> CollectorM m (LHS, Expr) -> CollectorM m ModuleItem +collectAsgnsM' strat = collectify $ traverseAsgnsM' strat + +traverseAsgnsM :: Monad m => MapperM m (LHS, Expr) -> MapperM m ModuleItem +traverseAsgnsM = traverseAsgnsM' IncludeTFs traverseAsgns :: Mapper (LHS, Expr) -> Mapper ModuleItem -traverseAsgns = unmonad traverseAsgnsM +traverseAsgns = traverseAsgns' IncludeTFs collectAsgnsM :: Monad m => CollectorM m (LHS, Expr) -> CollectorM m ModuleItem -collectAsgnsM = collectify traverseAsgnsM +collectAsgnsM = collectAsgnsM' IncludeTFs traverseNestedModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m ModuleItem traverseNestedModuleItemsM mapper item = do