rewrote PackedArray to properly handle the various scenarios

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

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]

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

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