From fd0bccfbd8cffdef3483df27c9c6ec28d27f42c1 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Thu, 28 Feb 2019 19:48:58 -0500 Subject: [PATCH] rewrote PackedArray to properly handle the various scenarios --- src/Convert/PackedArray.hs | 195 ++++++++++++++++++++---------- src/Convert/SplitPortDecl.hs | 2 +- src/Convert/Traverse.hs | 17 +++ src/Language/SystemVerilog/AST.hs | 18 +-- 4 files changed, 155 insertions(+), 77 deletions(-) diff --git a/src/Convert/PackedArray.hs b/src/Convert/PackedArray.hs index 3d49dbf..f7402e9 100644 --- a/src/Convert/PackedArray.hs +++ b/src/Convert/PackedArray.hs @@ -6,6 +6,19 @@ - This removes one dimension per identifier at a time. This works fine because - the conversions are repeatedly applied. - + - Packed arrays can be used in any of the following ways: A) as a whole, + - including as a port; B) with an index (`foo[0]`); or C) with a range + - (`foo[10:0]`). The rules for this conversion are: + - 1. If used with an index, then we must have an unflattened/unpacked + - version of that array after the conversion, so that we may get at the + - packed sub-arrays. + - 2. If used as a whole or with a range, then we must have a flattened + - version of that array after the conversion, so that we may get at a + - contiguous sequence of elements. + - 3. If both 1 and 2 apply, then we will make a fancy generate block to + - derive one from the other. The derivation direction is decided based on + - which version, if any, is exposed directly as a port. + - - TODO FIXME XXX: The Parser/AST don't yet support indexing into an identifier - twice, or indexing into an identifier, and then selecting a range. - @@ -18,6 +31,7 @@ module Convert.PackedArray (convert) where import Control.Monad.State import Data.List (partition) +import qualified Data.Set as Set import qualified Data.Map.Strict as Map import Convert.Traverse @@ -25,32 +39,67 @@ import Language.SystemVerilog.AST type DirMap = Map.Map Identifier Direction type DimMap = Map.Map Identifier (Type, Range) +type IdentSet = Set.Set Identifier + +data Info = Info + { sTypeDims :: DimMap + , sPortDirs :: DirMap + , sIdxUses :: IdentSet + , sSeqUses :: IdentSet } + deriving Show convert :: AST -> AST convert = traverseDescriptions convertDescription convertDescription :: Description -> Description -convertDescription description = +convertDescription (description @ (Module _ ports _)) = hoistPortDecls $ - traverseModuleItems (flattenModuleItem info . rewriteModuleItem dimMap') description + traverseModuleItems (flattenModuleItem info . rewriteModuleItem info) description where - info = execState - (collectModuleItemsM collectDecl description) - (Map.empty, Map.empty) - dimMap' = Map.restrictKeys (fst info) (Map.keysSet $ snd info) + -- collect all possible information info our Info structure + rawInfo = + execState (collectModuleItemsM (collectLHSsM collectLHS) description) $ + execState (collectModuleItemsM (collectExprsM collectExpr) description) $ + execState (collectModuleItemsM collectDecl description) $ + (Info Map.empty Map.empty Set.empty (Set.fromList ports)) + relevantIdents = Map.keysSet $ sTypeDims rawInfo + -- restrict the sets/maps to only contain keys which need transformation + info = rawInfo + { sPortDirs = Map.restrictKeys (sPortDirs rawInfo) relevantIdents + , sIdxUses = Set.intersection (sIdxUses rawInfo) relevantIdents + , sSeqUses = Set.intersection (sSeqUses rawInfo) relevantIdents } +convertDescription description = description -- collects port direction and packed-array dimension info into the state -collectDecl :: ModuleItem -> State (DimMap, DirMap) () +collectDecl :: ModuleItem -> State Info () collectDecl (MIDecl (Variable dir t ident _ _)) = do - let (tf, rs) = typeDims t + let (tf, rs) = typeRanges t if not (typeIsImplicit t) && length rs > 1 - then modify $ \(m, r) -> (Map.insert ident (tf $ tail rs, head rs) m, r) + then + let dets = (tf $ tail rs, head rs) in + modify $ \s -> s { sTypeDims = Map.insert ident dets (sTypeDims s) } else return () if dir /= Local - then modify $ \(m, r) -> (m, Map.insert ident dir r) + then modify $ \s -> s { sPortDirs = Map.insert ident dir (sPortDirs s) } else return () collectDecl _ = return () +-- collectors for identifier usage information +recordSeqUsage :: Identifier -> State Info () +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 (Ident i ) = recordSeqUsage i +collectExpr (IdentRange i _) = recordSeqUsage i +collectExpr (IdentBit i _) = recordIdxUsage i +collectExpr _ = return () +collectLHS :: LHS -> State Info () +collectLHS (LHS i ) = recordSeqUsage i +collectLHS (LHSRange i _) = recordSeqUsage i +collectLHS (LHSBit i _) = recordIdxUsage i +collectLHS (LHSConcat lhss) = mapM collectLHS lhss >>= \_ -> 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 -- relatively straightforward transformation, and testing in VCS is important. @@ -72,36 +121,37 @@ hoistPortDecls (Module name ports items) = hoistPortDecls other = other -- rewrite a module item if it contains a declaration to flatten -flattenModuleItem :: (DimMap, DirMap) -> ModuleItem -> ModuleItem -flattenModuleItem (dimMap, dirMap) (orig @ (MIDecl (Variable dir t ident a me))) = - -- if it doesn't need any mapping - if Map.notMember ident dimMap then - -- Skip! - orig - -- if it's not a port - else if Map.notMember ident dirMap then - -- move the packed dimension to the unpacked side - MIDecl $ Variable dir (tf $ tail rs) ident (a ++ [head rs]) me - -- if it is a port, but it's not the typed declaration - else if typeIsImplicit t then - -- flatten the ranges - newDecl -- see below - -- if it is a port, and it is the typed declaration of that por +flattenModuleItem :: Info -> ModuleItem -> ModuleItem +flattenModuleItem info (origDecl @ (MIDecl (Variable dir t ident a me))) = + -- if it doesn't need any mapping, then skip it + if Map.notMember ident typeDims then origDecl + -- if it is never used as a sequence (whole or range), then move the packed + -- dimension to the unpacked side + else if Set.notMember ident seqUses then flipDecl + -- if it is used as a sequence, but never indexed-into (sub-array), then + -- flatten (combine) the ranges, leaving them packed + else if Set.notMember ident duoUses then flatDecl + -- if it is both used as a sequence and is indexed-into else - -- do the fancy flatten-unflatten mapping - Generate $ (GenModuleItem newDecl) : genItems + -- if this is not the fully-typed declaration of this item, then flatten + -- it, but don't make the `generate` block this time to avoid duplicates + if typeIsImplicit t then flatDecl + -- otherwise, flatten it, and also create an unflattened copy + else Generate $ (GenModuleItem flatDecl) : genItems where - (tf, rs) = typeDims t - t' = tf $ flattenRanges rs - flipGen = Map.lookup ident dirMap == Just Input - genItems = unflattener flipGen ident (dimMap Map.! ident) - newDecl = MIDecl $ Variable dir t' ident a me + Info typeDims portDirs idxUses seqUses = info + duoUses = Set.intersection idxUses seqUses + writeToFlatVariant = Map.lookup ident portDirs == Just Output + genItems = unflattener writeToFlatVariant ident (typeDims Map.! ident) + (tf, rs) = typeRanges t + flipDecl = MIDecl $ Variable dir (tf $ tail rs) ident (a ++ [head rs]) me + flatDecl = MIDecl $ Variable dir (tf $ flattenRanges rs) ident a me flattenModuleItem _ other = other --- produces a generate block for creating a local unflattened copy of the given --- port-exposed flattened array +-- produces `generate` items for creating an unflattened copy of the given +-- flattened, packed array unflattener :: Bool -> Identifier -> (Type, Range) -> [GenItem] -unflattener shouldFlip arr (t, (majorHi, majorLo)) = +unflattener writeToFlatVariant arr (t, (majorHi, majorLo)) = [ GenModuleItem $ Comment $ "sv2v packed-array-flatten unflattener for " ++ arr , GenModuleItem $ MIDecl $ Variable Local t arrUnflat [(majorHi, majorLo)] Nothing , GenModuleItem $ Genvar index @@ -115,7 +165,7 @@ unflattener shouldFlip arr (t, (majorHi, majorLo)) = (simplify $ BinOp Add majorLo (BinOp Mul (Ident index) size)) , GenModuleItem $ (uncurry Assign) $ - if shouldFlip + if not writeToFlatVariant then (LHSBit arrUnflat $ Ident index, IdentRange arr origRange) else (LHSRange arr origRange, IdentBit arrUnflat $ Ident index) ] @@ -124,7 +174,7 @@ unflattener shouldFlip arr (t, (majorHi, majorLo)) = startBit = prefix "_tmp_start" arrUnflat = prefix arr index = prefix "_tmp_index" - (minorHi, minorLo) = head $ snd $ typeDims t + (minorHi, minorLo) = head $ snd $ typeRanges t size = simplify $ BinOp Add (BinOp Sub minorHi minorLo) (Number "1") localparam :: Identifier -> Expr -> GenItem localparam x v = GenModuleItem $ MIDecl $ Localparam (Implicit []) x v @@ -171,33 +221,44 @@ flattenRanges rs = r' = (simplify upper, e1) rs' = (tail $ tail rs) ++ [r'] -rewriteModuleItem :: DimMap -> ModuleItem -> ModuleItem -rewriteModuleItem dimMap = +rewriteModuleItem :: Info -> ModuleItem -> ModuleItem +rewriteModuleItem info = traverseStmts rewriteStmt . traverseExprs rewriteExpr where - rewriteIdent :: Identifier -> Identifier - rewriteIdent x = if Map.member x dimMap then prefix x else x + Info typeDims portDirs idxUses seqUses = info + duoUses = Set.intersection idxUses seqUses + + rewriteIdent :: Bool -> Identifier -> Identifier + rewriteIdent isAsgn x = + if isDuod && (isOutputPort == isAsgn) + then prefix x + else x + where + isDuod = Set.member x duoUses + isOutputPort = Map.lookup x portDirs == Just Output + rewriteReadIdent = rewriteIdent False + rewriteAsgnIdent = rewriteIdent True rewriteExpr :: Expr -> Expr - rewriteExpr (Ident i) = Ident (rewriteIdent i) - rewriteExpr (IdentBit i e) = IdentBit (rewriteIdent i) e + rewriteExpr (Ident i) = Ident (rewriteReadIdent i) + rewriteExpr (IdentBit i e) = IdentBit (rewriteReadIdent i) e rewriteExpr (IdentRange i (r @ (s, e))) = - case Map.lookup i dimMap of - Nothing -> IdentRange (rewriteIdent i) r - Just (t, _) -> - IdentRange i (simplify s', simplify e') - where - (a, b) = head $ snd $ typeDims t - size = BinOp Add (BinOp Sub a b) (Number "1") - s' = BinOp Sub (BinOp Mul size (BinOp Add s (Number "1"))) (Number "1") - e' = BinOp Mul size e + if Map.member i typeDims + then IdentRange i r' + else IdentRange i r + where + (a, b) = head $ snd $ typeRanges $ fst $ typeDims Map.! i + size = BinOp Add (BinOp Sub a b) (Number "1") + s' = BinOp Sub (BinOp Mul size (BinOp Add s (Number "1"))) (Number "1") + e' = BinOp Mul size e + r' = (simplify s', simplify e') rewriteExpr other = other rewriteLHS :: LHS -> LHS - rewriteLHS (LHS x ) = LHS (rewriteIdent x) - rewriteLHS (LHSBit x e) = LHSBit (rewriteIdent x) e - rewriteLHS (LHSRange x r) = LHSRange (rewriteIdent x) r + rewriteLHS (LHS x ) = LHS (rewriteAsgnIdent x) + rewriteLHS (LHSBit x e) = LHSBit (rewriteAsgnIdent x) e + rewriteLHS (LHSRange x r) = LHSRange (rewriteAsgnIdent x) r rewriteLHS (LHSConcat ls) = LHSConcat $ map rewriteLHS ls rewriteStmt :: Stmt -> Stmt @@ -206,17 +267,17 @@ rewriteModuleItem dimMap = rewriteStmt other = other convertAssignment :: (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt convertAssignment constructor (lhs @ (LHS ident)) (expr @ (Repeat _ exprs)) = - case Map.lookup ident dimMap of - Nothing -> constructor (rewriteLHS lhs) expr - Just (_, (a, b)) -> - For inir chkr incr assign - where - index = prefix $ ident ++ "_repeater_index" - assign = constructor - (LHSBit (prefix ident) (Ident index)) - (Concat exprs) - inir = (index, b) - chkr = BinOp Le (Ident index) a - incr = (index, BinOp Add (Ident index) (Number "1")) + if Map.member ident typeDims + then For inir chkr incr assign + else constructor (rewriteLHS lhs) expr + where + (_, (a, b)) = typeDims Map.! ident + index = prefix $ ident ++ "_repeater_index" + assign = constructor + (LHSBit (prefix ident) (Ident index)) + (Concat exprs) + inir = (index, b) + chkr = BinOp Le (Ident index) a + incr = (index, BinOp Add (Ident index) (Number "1")) convertAssignment constructor lhs expr = constructor (rewriteLHS lhs) expr diff --git a/src/Convert/SplitPortDecl.hs b/src/Convert/SplitPortDecl.hs index e3c6146..31bf300 100644 --- a/src/Convert/SplitPortDecl.hs +++ b/src/Convert/SplitPortDecl.hs @@ -24,5 +24,5 @@ splitPortDecl (orig @ (MIDecl (Variable _ (Implicit _) _ _ _))) = [orig] splitPortDecl (MIDecl (Variable d t x a me)) = [ MIDecl $ Variable d (Implicit r) x a Nothing , MIDecl $ Variable Local t x a me ] - where (_, r) = typeDims t + where (_, r) = typeRanges t splitPortDecl other = [other] diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 100f0d0..bdd0cf6 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -24,6 +24,9 @@ module Convert.Traverse , traverseExprsM , traverseExprs , collectExprsM +, traverseLHSsM +, traverseLHSs +, collectLHSsM ) where import Data.Maybe (fromJust) @@ -259,3 +262,17 @@ traverseExprs :: Mapper Expr -> Mapper ModuleItem traverseExprs = unmonad traverseExprsM collectExprsM :: Monad m => CollectorM m Expr -> CollectorM m ModuleItem collectExprsM = collectify traverseExprsM + +traverseLHSsM :: Monad m => MapperM m LHS -> MapperM m ModuleItem +traverseLHSsM mapper item = + traverseStmtsM (traverseStmtLHSsM mapper) item >>= traverseModuleItemLHSsM + where + traverseModuleItemLHSsM (Assign lhs expr) = do + lhs' <- mapper lhs + return $ Assign lhs' expr + traverseModuleItemLHSsM other = return other + +traverseLHSs :: Mapper LHS -> Mapper ModuleItem +traverseLHSs = unmonad traverseLHSsM +collectLHSsM :: Monad m => CollectorM m LHS -> CollectorM m ModuleItem +collectLHSsM = collectify traverseLHSsM diff --git a/src/Language/SystemVerilog/AST.hs b/src/Language/SystemVerilog/AST.hs index 209f308..e2b7fc2 100644 --- a/src/Language/SystemVerilog/AST.hs +++ b/src/Language/SystemVerilog/AST.hs @@ -19,7 +19,7 @@ module Language.SystemVerilog.AST , Case , Range , GenCase - , typeDims + , typeRanges ) where import Data.List @@ -94,14 +94,14 @@ instance Show Type where showVal :: (Identifier, Maybe Expr) -> String showVal (x, e) = x ++ (showAssignment e) -typeDims :: Type -> ([Range] -> Type, [Range]) -typeDims (Reg r) = (Reg , r) -typeDims (Wire r) = (Wire , r) -typeDims (Logic r) = (Logic , r) -typeDims (Alias t r) = (Alias t, r) -typeDims (Implicit r) = (Implicit, r) -typeDims (IntegerT ) = (error "ranges cannot be applied to IntegerT", []) -typeDims (Enum t v r) = (Enum t v, r) +typeRanges :: Type -> ([Range] -> Type, [Range]) +typeRanges (Reg r) = (Reg , r) +typeRanges (Wire r) = (Wire , r) +typeRanges (Logic r) = (Logic , r) +typeRanges (Alias t r) = (Alias t, r) +typeRanges (Implicit r) = (Implicit, r) +typeRanges (IntegerT ) = (error "ranges cannot be applied to IntegerT", []) +typeRanges (Enum t v r) = (Enum t v, r) data Decl = Parameter Type Identifier Expr