From 35d8644f2aa4ba0eeb6ea180abf1049b81991445 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Mon, 18 Mar 2019 14:27:14 -0400 Subject: [PATCH] fix PackedArray with whole array uses by allowing top-level Expr and LHS traversal --- src/Convert/Enum.hs | 2 +- src/Convert/Interface.hs | 8 ++++---- src/Convert/Logic.hs | 3 ++- src/Convert/PackedArray.hs | 20 +++++++++++++------- src/Convert/Traverse.hs | 27 ++++++++++++++++++++++----- 5 files changed, 42 insertions(+), 18 deletions(-) diff --git a/src/Convert/Enum.hs b/src/Convert/Enum.hs index 8431a8e..506eb92 100644 --- a/src/Convert/Enum.hs +++ b/src/Convert/Enum.hs @@ -35,7 +35,7 @@ convertDescription (description @ (Part _ _ _ _)) = enumItems = map (\(x, v) -> MIDecl $ Localparam (Implicit []) x v) enumPairs (Part kw name ports items, enums) = runWriter $ traverseModuleItemsM (traverseTypesM traverseType) $ - traverseModuleItems (traverseExprs traverseExpr) $ + traverseModuleItems (traverseExprs $ traverseNestedExprs traverseExpr) $ description traverseType :: Type -> Writer Enums Type traverseType (Enum t v r) = do diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs index 0c308ec..190a31f 100644 --- a/src/Convert/Interface.hs +++ b/src/Convert/Interface.hs @@ -38,8 +38,8 @@ convertDescription interfaces (Part Module name ports items) = Part Module name ports' items' where items' = - map (traverseNestedModuleItems $ traverseExprs convertExpr) $ - map (traverseNestedModuleItems $ traverseLHSs convertLHS) $ + map (traverseNestedModuleItems $ traverseExprs (traverseNestedExprs convertExpr)) $ + map (traverseNestedModuleItems $ traverseLHSs (traverseNestedLHSs convertLHS)) $ map (traverseNestedModuleItems mapInterface) $ items ports' = concatMap convertPort ports @@ -132,8 +132,8 @@ convertDescription _ other = other prefixModuleItems :: Identifier -> ModuleItem -> ModuleItem prefixModuleItems prefix = traverseDecls prefixDecl . - traverseExprs prefixExpr . - traverseLHSs prefixLHS + traverseExprs (traverseNestedExprs prefixExpr) . + traverseLHSs (traverseNestedLHSs prefixLHS ) where prefixDecl :: Decl -> Decl prefixDecl (Variable d t x a me) = Variable d t (prefix ++ x) a me diff --git a/src/Convert/Logic.hs b/src/Convert/Logic.hs index 577cbce..f33dd28 100644 --- a/src/Convert/Logic.hs +++ b/src/Convert/Logic.hs @@ -43,7 +43,8 @@ convertDescription other = other regIdents :: ModuleItem -> Writer RegIdents () regIdents (AlwaysC _ stmt) = - collectStmtLHSsM idents $ traverseNestedStmts removeTimings stmt + collectStmtLHSsM (collectNestedLHSsM idents) $ + traverseNestedStmts removeTimings stmt where idents :: LHS -> Writer RegIdents () idents (LHSIdent vx ) = tell $ Set.singleton vx diff --git a/src/Convert/PackedArray.hs b/src/Convert/PackedArray.hs index e67cd4d..ad2b8bf 100644 --- a/src/Convert/PackedArray.hs +++ b/src/Convert/PackedArray.hs @@ -87,13 +87,19 @@ recordSeqUsage i = modify $ \s -> s { sSeqUses = Set.insert i $ sSeqUses s } recordIdxUsage :: Identifier -> State Info () recordIdxUsage i = modify $ \s -> s { sIdxUses = Set.insert i $ sIdxUses s } collectExpr :: Expr -> State Info () -collectExpr (Range (Ident i) _) = recordSeqUsage i -collectExpr (Bit (Ident i) _) = recordIdxUsage i -collectExpr _ = return () +collectExpr (Ident i) = recordSeqUsage i +collectExpr other = collectNestedExprsM collectNestedExpr other +collectNestedExpr :: Expr -> State Info () +collectNestedExpr (Range (Ident i) _) = recordSeqUsage i +collectNestedExpr (Bit (Ident i) _) = recordIdxUsage i +collectNestedExpr _ = return () collectLHS :: LHS -> State Info () -collectLHS (LHSRange (LHSIdent i) _) = recordSeqUsage i -collectLHS (LHSBit (LHSIdent i) _) = recordIdxUsage i -collectLHS _ = return () +collectLHS (LHSIdent i) = recordSeqUsage i +collectLHS other = collectNestedLHSsM collectNestedLHS other +collectNestedLHS :: LHS -> State Info () +collectNestedLHS (LHSRange (LHSIdent i) _) = recordSeqUsage i +collectNestedLHS (LHSBit (LHSIdent i) _) = recordIdxUsage i +collectNestedLHS _ = return () -- VCS doesn't like port declarations inside of `generate` blocks, so we hoist -- them out with this function. This obviously isn't ideal, but it's a @@ -205,7 +211,7 @@ flattenRanges rs = rewriteModuleItem :: Info -> ModuleItem -> ModuleItem rewriteModuleItem info = traverseStmts rewriteStmt . - traverseExprs rewriteExpr + traverseExprs (traverseNestedExprs rewriteExpr) where Info typeDims _ idxUses seqUses = info duoUses = Set.intersection idxUses seqUses diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index ae57fdb..5e24145 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -43,6 +43,11 @@ module Convert.Traverse , traverseNestedModuleItems , collectNestedModuleItemsM , traverseNestedStmts +, traverseNestedExprs +, collectNestedExprsM +, traverseNestedLHSsM +, traverseNestedLHSs +, collectNestedLHSsM ) where import Control.Monad.State @@ -156,7 +161,7 @@ traverseNestedStmtsM mapper = fullMapper traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt traverseStmtLHSsM mapper = traverseNestedStmtsM stmtMapper where - fullMapper = traverseNestedLHSsM mapper + fullMapper = mapper stmtMapper (Timing (Event sense) stmt) = do sense' <- senseMapper sense return $ Timing (Event sense') stmt @@ -248,7 +253,7 @@ traverseExprsM mapper = moduleItemMapper me' <- maybeExprMapper me return $ Variable d t x a' me' - exprMapper = traverseNestedExprsM mapper + exprMapper = mapper caseMapper (exprs, stmt) = do exprs' <- mapM exprMapper exprs @@ -334,10 +339,10 @@ traverseLHSsM mapper item = traverseStmtsM (traverseStmtLHSsM mapper) item >>= traverseModuleItemLHSsM where traverseModuleItemLHSsM (Assign lhs expr) = do - lhs' <- traverseNestedLHSsM mapper lhs + lhs' <- mapper lhs return $ Assign lhs' expr traverseModuleItemLHSsM (Defparam lhs expr) = do - lhs' <- traverseNestedLHSsM mapper lhs + lhs' <- mapper lhs return $ Defparam lhs' expr traverseModuleItemLHSsM other = return other @@ -356,6 +361,11 @@ traverseNestedLHSsM mapper = fullMapper tl (LHSDot l x ) = fullMapper l >>= \l' -> return $ LHSDot l' x tl (LHSConcat lhss) = mapM fullMapper lhss >>= return . LHSConcat +traverseNestedLHSs :: Mapper LHS -> Mapper LHS +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 item' <- miMapperA item @@ -382,7 +392,9 @@ collectDeclsM = collectify traverseDeclsM traverseTypesM :: Monad m => MapperM m Type -> MapperM m ModuleItem traverseTypesM mapper item = - miMapper item >>= traverseDeclsM declMapper >>= traverseExprsM exprMapper + miMapper item >>= + traverseDeclsM declMapper >>= + traverseExprsM (traverseNestedExprsM exprMapper) where fullMapper t = tm t >>= mapper tm (Reg r) = return $ Reg r @@ -497,3 +509,8 @@ collectNestedModuleItemsM = collectify traverseNestedModuleItemsM traverseNestedStmts :: Mapper Stmt -> Mapper Stmt traverseNestedStmts = unmonad traverseNestedStmtsM + +traverseNestedExprs :: Mapper Expr -> Mapper Expr +traverseNestedExprs = unmonad traverseNestedExprsM +collectNestedExprsM :: Monad m => CollectorM m Expr -> CollectorM m Expr +collectNestedExprsM = collectify traverseNestedExprsM