Commit 35d8644f by Zachary Snow

fix PackedArray with whole array uses by allowing top-level Expr and LHS traversal

parent 1d2eccb3
...@@ -35,7 +35,7 @@ convertDescription (description @ (Part _ _ _ _)) = ...@@ -35,7 +35,7 @@ convertDescription (description @ (Part _ _ _ _)) =
enumItems = map (\(x, v) -> MIDecl $ Localparam (Implicit []) x v) enumPairs enumItems = map (\(x, v) -> MIDecl $ Localparam (Implicit []) x v) enumPairs
(Part kw name ports items, enums) = (Part kw name ports items, enums) =
runWriter $ traverseModuleItemsM (traverseTypesM traverseType) $ runWriter $ traverseModuleItemsM (traverseTypesM traverseType) $
traverseModuleItems (traverseExprs traverseExpr) $ traverseModuleItems (traverseExprs $ traverseNestedExprs traverseExpr) $
description description
traverseType :: Type -> Writer Enums Type traverseType :: Type -> Writer Enums Type
traverseType (Enum t v r) = do traverseType (Enum t v r) = do
......
...@@ -38,8 +38,8 @@ convertDescription interfaces (Part Module name ports items) = ...@@ -38,8 +38,8 @@ convertDescription interfaces (Part Module name ports items) =
Part Module name ports' items' Part Module name ports' items'
where where
items' = items' =
map (traverseNestedModuleItems $ traverseExprs convertExpr) $ map (traverseNestedModuleItems $ traverseExprs (traverseNestedExprs convertExpr)) $
map (traverseNestedModuleItems $ traverseLHSs convertLHS) $ map (traverseNestedModuleItems $ traverseLHSs (traverseNestedLHSs convertLHS)) $
map (traverseNestedModuleItems mapInterface) $ map (traverseNestedModuleItems mapInterface) $
items items
ports' = concatMap convertPort ports ports' = concatMap convertPort ports
...@@ -132,8 +132,8 @@ convertDescription _ other = other ...@@ -132,8 +132,8 @@ convertDescription _ other = other
prefixModuleItems :: Identifier -> ModuleItem -> ModuleItem prefixModuleItems :: Identifier -> ModuleItem -> ModuleItem
prefixModuleItems prefix = prefixModuleItems prefix =
traverseDecls prefixDecl . traverseDecls prefixDecl .
traverseExprs prefixExpr . traverseExprs (traverseNestedExprs prefixExpr) .
traverseLHSs prefixLHS traverseLHSs (traverseNestedLHSs prefixLHS )
where where
prefixDecl :: Decl -> Decl prefixDecl :: Decl -> Decl
prefixDecl (Variable d t x a me) = Variable d t (prefix ++ x) a me prefixDecl (Variable d t x a me) = Variable d t (prefix ++ x) a me
......
...@@ -43,7 +43,8 @@ convertDescription other = other ...@@ -43,7 +43,8 @@ convertDescription other = other
regIdents :: ModuleItem -> Writer RegIdents () regIdents :: ModuleItem -> Writer RegIdents ()
regIdents (AlwaysC _ stmt) = regIdents (AlwaysC _ stmt) =
collectStmtLHSsM idents $ traverseNestedStmts removeTimings stmt collectStmtLHSsM (collectNestedLHSsM idents) $
traverseNestedStmts removeTimings stmt
where where
idents :: LHS -> Writer RegIdents () idents :: LHS -> Writer RegIdents ()
idents (LHSIdent vx ) = tell $ Set.singleton vx idents (LHSIdent vx ) = tell $ Set.singleton vx
......
...@@ -87,13 +87,19 @@ recordSeqUsage i = modify $ \s -> s { sSeqUses = Set.insert i $ sSeqUses s } ...@@ -87,13 +87,19 @@ recordSeqUsage i = modify $ \s -> s { sSeqUses = Set.insert i $ sSeqUses s }
recordIdxUsage :: Identifier -> State Info () recordIdxUsage :: Identifier -> State Info ()
recordIdxUsage i = modify $ \s -> s { sIdxUses = Set.insert i $ sIdxUses s } recordIdxUsage i = modify $ \s -> s { sIdxUses = Set.insert i $ sIdxUses s }
collectExpr :: Expr -> State Info () collectExpr :: Expr -> State Info ()
collectExpr (Range (Ident i) _) = recordSeqUsage i collectExpr (Ident i) = recordSeqUsage i
collectExpr (Bit (Ident i) _) = recordIdxUsage i collectExpr other = collectNestedExprsM collectNestedExpr other
collectExpr _ = return () collectNestedExpr :: Expr -> State Info ()
collectNestedExpr (Range (Ident i) _) = recordSeqUsage i
collectNestedExpr (Bit (Ident i) _) = recordIdxUsage i
collectNestedExpr _ = return ()
collectLHS :: LHS -> State Info () collectLHS :: LHS -> State Info ()
collectLHS (LHSRange (LHSIdent i) _) = recordSeqUsage i collectLHS (LHSIdent i) = recordSeqUsage i
collectLHS (LHSBit (LHSIdent i) _) = recordIdxUsage i collectLHS other = collectNestedLHSsM collectNestedLHS other
collectLHS _ = return () 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 -- 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 -- them out with this function. This obviously isn't ideal, but it's a
...@@ -205,7 +211,7 @@ flattenRanges rs = ...@@ -205,7 +211,7 @@ flattenRanges rs =
rewriteModuleItem :: Info -> ModuleItem -> ModuleItem rewriteModuleItem :: Info -> ModuleItem -> ModuleItem
rewriteModuleItem info = rewriteModuleItem info =
traverseStmts rewriteStmt . traverseStmts rewriteStmt .
traverseExprs rewriteExpr traverseExprs (traverseNestedExprs rewriteExpr)
where where
Info typeDims _ idxUses seqUses = info Info typeDims _ idxUses seqUses = info
duoUses = Set.intersection idxUses seqUses duoUses = Set.intersection idxUses seqUses
......
...@@ -43,6 +43,11 @@ module Convert.Traverse ...@@ -43,6 +43,11 @@ module Convert.Traverse
, traverseNestedModuleItems , traverseNestedModuleItems
, collectNestedModuleItemsM , collectNestedModuleItemsM
, traverseNestedStmts , traverseNestedStmts
, traverseNestedExprs
, collectNestedExprsM
, traverseNestedLHSsM
, traverseNestedLHSs
, collectNestedLHSsM
) where ) where
import Control.Monad.State import Control.Monad.State
...@@ -156,7 +161,7 @@ traverseNestedStmtsM mapper = fullMapper ...@@ -156,7 +161,7 @@ traverseNestedStmtsM mapper = fullMapper
traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt
traverseStmtLHSsM mapper = traverseNestedStmtsM stmtMapper traverseStmtLHSsM mapper = traverseNestedStmtsM stmtMapper
where where
fullMapper = traverseNestedLHSsM mapper fullMapper = mapper
stmtMapper (Timing (Event sense) stmt) = do stmtMapper (Timing (Event sense) stmt) = do
sense' <- senseMapper sense sense' <- senseMapper sense
return $ Timing (Event sense') stmt return $ Timing (Event sense') stmt
...@@ -248,7 +253,7 @@ traverseExprsM mapper = moduleItemMapper ...@@ -248,7 +253,7 @@ traverseExprsM mapper = moduleItemMapper
me' <- maybeExprMapper me me' <- maybeExprMapper me
return $ Variable d t x a' me' return $ Variable d t x a' me'
exprMapper = traverseNestedExprsM mapper exprMapper = mapper
caseMapper (exprs, stmt) = do caseMapper (exprs, stmt) = do
exprs' <- mapM exprMapper exprs exprs' <- mapM exprMapper exprs
...@@ -334,10 +339,10 @@ traverseLHSsM mapper item = ...@@ -334,10 +339,10 @@ traverseLHSsM mapper item =
traverseStmtsM (traverseStmtLHSsM mapper) item >>= traverseModuleItemLHSsM traverseStmtsM (traverseStmtLHSsM mapper) item >>= traverseModuleItemLHSsM
where where
traverseModuleItemLHSsM (Assign lhs expr) = do traverseModuleItemLHSsM (Assign lhs expr) = do
lhs' <- traverseNestedLHSsM mapper lhs lhs' <- mapper lhs
return $ Assign lhs' expr return $ Assign lhs' expr
traverseModuleItemLHSsM (Defparam lhs expr) = do traverseModuleItemLHSsM (Defparam lhs expr) = do
lhs' <- traverseNestedLHSsM mapper lhs lhs' <- mapper lhs
return $ Defparam lhs' expr return $ Defparam lhs' expr
traverseModuleItemLHSsM other = return other traverseModuleItemLHSsM other = return other
...@@ -356,6 +361,11 @@ traverseNestedLHSsM mapper = fullMapper ...@@ -356,6 +361,11 @@ traverseNestedLHSsM mapper = fullMapper
tl (LHSDot l x ) = fullMapper l >>= \l' -> return $ LHSDot l' x tl (LHSDot l x ) = fullMapper l >>= \l' -> return $ LHSDot l' x
tl (LHSConcat lhss) = mapM fullMapper lhss >>= return . LHSConcat 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 :: Monad m => MapperM m Decl -> MapperM m ModuleItem
traverseDeclsM mapper item = do traverseDeclsM mapper item = do
item' <- miMapperA item item' <- miMapperA item
...@@ -382,7 +392,9 @@ collectDeclsM = collectify traverseDeclsM ...@@ -382,7 +392,9 @@ collectDeclsM = collectify traverseDeclsM
traverseTypesM :: Monad m => MapperM m Type -> MapperM m ModuleItem traverseTypesM :: Monad m => MapperM m Type -> MapperM m ModuleItem
traverseTypesM mapper item = traverseTypesM mapper item =
miMapper item >>= traverseDeclsM declMapper >>= traverseExprsM exprMapper miMapper item >>=
traverseDeclsM declMapper >>=
traverseExprsM (traverseNestedExprsM exprMapper)
where where
fullMapper t = tm t >>= mapper fullMapper t = tm t >>= mapper
tm (Reg r) = return $ Reg r tm (Reg r) = return $ Reg r
...@@ -497,3 +509,8 @@ collectNestedModuleItemsM = collectify traverseNestedModuleItemsM ...@@ -497,3 +509,8 @@ collectNestedModuleItemsM = collectify traverseNestedModuleItemsM
traverseNestedStmts :: Mapper Stmt -> Mapper Stmt traverseNestedStmts :: Mapper Stmt -> Mapper Stmt
traverseNestedStmts = unmonad traverseNestedStmtsM traverseNestedStmts = unmonad traverseNestedStmtsM
traverseNestedExprs :: Mapper Expr -> Mapper Expr
traverseNestedExprs = unmonad traverseNestedExprsM
collectNestedExprsM :: Monad m => CollectorM m Expr -> CollectorM m Expr
collectNestedExprsM = collectify traverseNestedExprsM
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment