major array pack and flatten update (closes #48)

- dimensions flattening conversion only flattens packed dimensions
- conversion for packing arrays when necessary (preserves memories)
- added coverage for array with multiple packed dimensions
- test runner no longer forbids multi-dim accesses after conversion
- Decl and subordinate types derive Ord

src/Convert.hs

@@ -24,10 +24,10 @@ import qualified Convert.IntTypes
 import qualified Convert.KWArgs
 import qualified Convert.Logic
 import qualified Convert.LogOp
+import qualified Convert.MultiplePacked
 import qualified Convert.NamedBlock
 import qualified Convert.NestPI
 import qualified Convert.Package
-import qualified Convert.PackedArray
 import qualified Convert.ParamType
 import qualified Convert.RemoveComments
 import qualified Convert.Return
@@ -40,6 +40,7 @@ import qualified Convert.Struct
 import qualified Convert.Typedef
 import qualified Convert.UnbasedUnsized
 import qualified Convert.Unique
+import qualified Convert.UnpackedArray
 import qualified Convert.Unsigned
 
 type Phase = [AST] -> [AST]
@@ -57,7 +58,7 @@ phases excludes =
     , Convert.IntTypes.convert
     , Convert.KWArgs.convert
     , Convert.LogOp.convert
-    , Convert.PackedArray.convert
+    , Convert.MultiplePacked.convert
     , Convert.DimensionQuery.convert
     , Convert.ParamType.convert
     , Convert.SizeCast.convert
@@ -69,6 +70,7 @@ phases excludes =
     , Convert.Typedef.convert
     , Convert.UnbasedUnsized.convert
     , Convert.Unique.convert
+    , Convert.UnpackedArray.convert
     , Convert.Unsigned.convert
     , Convert.Package.convert
     , Convert.Enum.convert

src/Convert/MultiplePacked.hs

@@ -1,72 +1,67 @@
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
- - Conversion for flattening multi-dimensional packed arrays
+ - Conversion for flattening variables with multiple packed dimensions
  -
- - This removes one dimension per identifier at a time. This works fine because
- - the conversions are repeatedly applied.
+ - This removes one packed dimension per identifier per pass. This works fine
+ - because all conversions are repeatedly applied.
  -
  - We previously had a very complex conversion which used `generate` to make
  - flattened and unflattened versions of the array as necessary. This has now
  - been "simplified" to always flatten the array, and then rewrite all usages of
  - the array as appropriate.
  -
+ - A previous iteration of this conversion aggressively flattened all dimensions
+ - (even if unpacked) in any multidimensional data declaration. This had the
+ - unfortunate side effect of packing memories, which could hinder efficient
+ - synthesis. Now this conversion only flattens packed dimensions and leaves the
+ - (only potentially necessary) movement of dimensions from unpacked to packed
+ - to the separate UnpackedArray conversion.
+ -
  - Note that the ranges being combined may not be of the form [hi:lo], and need
  - not even be the same direction! Because of this, we have to flip around the
  - indices of certain accesses.
  -}
 
-module Convert.PackedArray (convert) where
+module Convert.MultiplePacked (convert) where
 
 import Control.Monad.State
 import Data.Tuple (swap)
+import Data.Maybe (isJust, fromJust)
 import qualified Data.Map.Strict as Map
 
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type DimMap = Map.Map Identifier [Range]
-
-data Info = Info
-    { sTypeDims :: DimMap
-    } deriving (Eq, Show)
+type Info = Map.Map Identifier ([Range], [Range])
 
 convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
 convertDescription =
-    scopedConversion traverseDeclM traverseModuleItemM traverseStmtM
-        (Info Map.empty)
+    scopedConversion traverseDeclM traverseModuleItemM traverseStmtM Map.empty
 
--- collects and converts multi-dimensional packed-array declarations
+-- collects and converts declarations with multiple packed dimensions
 traverseDeclM :: Decl -> State Info Decl
 traverseDeclM (Variable dir t ident a me) = do
-    let (tf, rs) = typeRanges t
-    if dir /= Local || (rs /= [] && a /= [])
-        then do
-            let t' = tf $ a ++ rs
-            t'' <- traverseDeclM' t' ident
-            return $ Variable dir t'' ident [] me
-        else do
-            t' <- traverseDeclM' t ident
-            return $ Variable dir t' ident a me
+    t' <- traverseTypeM t a ident
+    return $ Variable dir t' ident a me
 traverseDeclM (Param s t ident e) = do
-    t' <- traverseDeclM' t ident
+    t' <- traverseTypeM t [] ident
     return $ Param s t' ident e
 traverseDeclM (ParamType s ident mt) =
     return $ ParamType s ident mt
 
-traverseDeclM' :: Type -> Identifier -> State Info Type
-traverseDeclM' t ident = do
-    Info typeDims <- get
+traverseTypeM :: Type -> [Range] -> Identifier -> State Info Type
+traverseTypeM t a ident = do
     let (tf, rs) = typeRanges t
     if length rs <= 1
         then do
-            put $ Info $ Map.delete ident typeDims
+            modify $ Map.delete ident
             return t
         else do
-            put $ Info $ Map.insert ident rs typeDims
+            modify $ Map.insert ident (rs, a)
             let r1 : r2 : rest = rs
             let rs' = (combineRanges r1 r2) : rest
             return $ tf rs'
@@ -106,20 +101,52 @@ traverseStmtM stmt =
 traverseExprM :: Expr -> State Info Expr
 traverseExprM = traverseNestedExprsM $ stately traverseExpr
 
+-- LHSs need to be converted too. Rather than duplicating the procedures, we
+-- turn LHSs into expressions temporarily and use the expression conversion.
 traverseLHSM :: LHS -> State Info LHS
-traverseLHSM = traverseNestedLHSsM $ stately traverseLHS
+traverseLHSM lhs = do
+    let expr = lhsToExpr lhs
+    expr' <- traverseExprM expr
+    return $ fromJust $ exprToLHS expr'
 
 traverseExpr :: Info -> Expr -> Expr
-traverseExpr info =
+traverseExpr typeDims =
     rewriteExpr
     where
-        typeDims = sTypeDims info
+        -- removes the innermost dimensions of the given packed and unpacked
+        -- dimensions, and applies the given transformation to the expression
+        dropLevel
+            :: (Expr -> Expr)
+            -> ([Range], [Range], Expr)
+            -> ([Range], [Range], Expr)
+        dropLevel nest ([], [], expr) =
+            ([], [], nest expr)
+        dropLevel nest (packed, [], expr) =
+            (tail packed, [], nest expr)
+        dropLevel nest (packed, unpacked, expr) =
+            (packed, tail unpacked, nest expr)
 
-        dims :: Identifier -> (Range, Range)
-        dims x =
-            (dimInner, dimOuter)
-            where
-                dimInner : dimOuter : _ = typeDims Map.! x
+        -- given an expression, returns the packed and unpacked dimensions and a
+        -- tagged version of the expression, if possible
+        levels :: Expr -> Maybe ([Range], [Range], Expr)
+        levels (Ident x) =
+            case Map.lookup x typeDims of
+                Just (a, b) -> Just (a, b, Ident $ tag : x)
+                Nothing -> Nothing
+        levels (Bit expr a) =
+            fmap (dropLevel $ \expr' -> Bit expr' a) (levels expr)
+        levels (Range expr a b) =
+            fmap (dropLevel $ \expr' -> Range expr' a b) (levels expr)
+        levels _ = Nothing
+
+        -- given an expression, returns the two innermost packed dimensions and a
+        -- tagged version of the expression, if possible
+        dims :: Expr -> Maybe (Range, Range, Expr)
+        dims expr =
+            case levels expr of
+                Just (dimInner : dimOuter : _, [], expr') ->
+                    Just (dimInner, dimOuter, expr')
+                _ -> Nothing
 
         -- if the given range is flipped, the result will flip around the given
         -- indexing expression
@@ -141,55 +168,36 @@ traverseExpr info =
             if head x == tag
                 then Ident $ tail x
                 else Ident x
-        rewriteExpr (orig @ (Bit (Bit (Ident x) idxInner) idxOuter)) =
-            if Map.member x typeDims
-                then Bit (Ident x') idx'
+        rewriteExpr (orig @ (Bit (Bit expr idxInner) idxOuter)) =
+            if isJust maybeDims
+                then Bit expr' idx'
                 else orig
             where
-                (dimInner, dimOuter) = dims x
-                x' = tag : x
+                maybeDims = dims $ rewriteExpr expr
+                Just (dimInner, dimOuter, expr') = maybeDims
                 idxInner' = orientIdx dimInner idxInner
                 idxOuter' = orientIdx dimOuter idxOuter
                 base = BinOp Mul idxInner' (rangeSize dimOuter)
                 idx' = simplify $ BinOp Add base idxOuter'
-        rewriteExpr (orig @ (Bit (Ident x) idx)) =
-            if Map.member x typeDims
-                then Range (Ident x') mode' range'
+        rewriteExpr (orig @ (Bit expr idx)) =
+            if isJust maybeDims
+                then Range expr' mode' range'
                 else orig
             where
-                (dimInner, dimOuter) = dims x
-                x' = tag : x
+                maybeDims = dims $ rewriteExpr expr
+                Just (dimInner, dimOuter, expr') = maybeDims
                 mode' = IndexedPlus
                 idx' = orientIdx dimInner idx
                 len = rangeSize dimOuter
                 base = BinOp Add (endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)) (BinOp Mul idx' len)
                 range' = (simplify base, simplify len)
-        rewriteExpr (orig @ (Range (Ident x) mode range)) =
-            if Map.member x typeDims
-                then Range (Ident x') mode' range'
+        rewriteExpr (orig @ (Range (Bit expr idxInner) modeOuter rangeOuter)) =
+            if isJust maybeDims
+                then Range expr' mode' range'
                 else orig
             where
-                (_, dimOuter) = dims x
-                x' = tag : x
-                mode' = mode
-                size = rangeSize dimOuter
-                base = endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)
-                range' =
-                    case mode of
-                        NonIndexed   ->
-                            (simplify hi, simplify lo)
-                            where
-                                lo = BinOp Mul size (snd range)
-                                hi = BinOp Sub (BinOp Add lo (BinOp Mul (rangeSize range) size)) (Number "1")
-                        IndexedPlus  -> (BinOp Add (BinOp Mul size (fst range)) base, BinOp Mul size (snd range))
-                        IndexedMinus -> (BinOp Add (BinOp Mul size (fst range)) base, BinOp Mul size (snd range))
-        rewriteExpr (orig @ (Range (Bit (Ident x) idxInner) modeOuter rangeOuter)) =
-            if Map.member x typeDims
-                then Range (Ident x') mode' range'
-                else orig
-            where
-                (dimInner, dimOuter) = dims x
-                x' = tag : x
+                maybeDims = dims $ rewriteExpr expr
+                Just (dimInner, dimOuter, expr') = maybeDims
                 mode' = IndexedPlus
                 idxInner' = orientIdx dimInner idxInner
                 rangeOuterReverseIndexed =
@@ -208,49 +216,23 @@ traverseExpr info =
                 base = simplify $ BinOp Add start idxOuter'
                 len = lenOuter
                 range' = (base, len)
+        rewriteExpr (orig @ (Range expr mode range)) =
+            if isJust maybeDims
+                then Range expr' mode' range'
+                else orig
+            where
+                maybeDims = dims $ rewriteExpr expr
+                Just (_, dimOuter, expr') = maybeDims
+                mode' = mode
+                size = rangeSize dimOuter
+                base = endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)
+                range' =
+                    case mode of
+                        NonIndexed   ->
+                            (simplify hi, simplify lo)
+                            where
+                                lo = BinOp Mul size (snd range)
+                                hi = BinOp Sub (BinOp Add lo (BinOp Mul (rangeSize range) size)) (Number "1")
+                        IndexedPlus  -> (BinOp Add (BinOp Mul size (fst range)) base, BinOp Mul size (snd range))
+                        IndexedMinus -> (BinOp Add (BinOp Mul size (fst range)) base, BinOp Mul size (snd range))
         rewriteExpr other = other
-
--- LHSs need to be converted too. Rather than duplicating the procedures, we
--- turn the relevant LHSs into expressions temporarily and use the expression
--- conversion written above.
-traverseLHS :: Info -> LHS -> LHS
-traverseLHS info =
-    rewriteLHS
-    where
-        typeDims = sTypeDims info
-        rewriteExpr = traverseExpr info
-
-        rewriteLHS :: LHS -> LHS
-        rewriteLHS (LHSIdent x) =
-            LHSIdent x'
-            where Ident x' = rewriteExpr (Ident x)
-        rewriteLHS (orig @ (LHSBit (LHSBit (LHSIdent x) idxInner) idxOuter)) =
-            if Map.member x typeDims
-                then LHSBit (LHSIdent x') idx'
-                else orig
-            where Bit (Ident x') idx' =
-                    rewriteExpr (Bit (Bit (Ident x) idxInner) idxOuter)
-        rewriteLHS (orig @ (LHSBit (LHSRange (LHSIdent x) modeInner rangeInner) idxOuter)) =
-            if Map.member x typeDims
-                then LHSRange (LHSIdent x') mode' range'
-                else orig
-            where Range (Ident x') mode' range' =
-                    rewriteExpr (Bit (Range (Ident x) modeInner rangeInner) idxOuter)
-        rewriteLHS (orig @ (LHSBit (LHSIdent x) idx)) =
-            if Map.member x typeDims
-                then LHSRange (LHSIdent x') mode' range'
-                else orig
-            where Range (Ident x') mode' range' = rewriteExpr (Bit (Ident x) idx)
-        rewriteLHS (orig @ (LHSRange (LHSIdent x) mode range)) =
-            if Map.member x typeDims
-                then LHSRange (LHSIdent x') mode' range'
-                else orig
-            where Range (Ident x') mode' range' =
-                    rewriteExpr (Range (Ident x) mode range)
-        rewriteLHS (orig @ (LHSRange (LHSBit (LHSIdent x) idxInner) modeOuter rangeOuter)) =
-            if Map.member x typeDims
-                then LHSRange (LHSIdent x') mode' range'
-                else orig
-            where Range (Ident x') mode' range' =
-                    rewriteExpr (Range (Bit (Ident x) idxInner) modeOuter rangeOuter)
-        rewriteLHS other = other

src/Convert/SizeCast.hs

@@ -15,7 +15,7 @@ import Convert.Traverse
 import Language.SystemVerilog.AST
 
 type TypeMap = Map.Map Identifier Type
-type CastSet  = Set.Set (Expr, Signing)
+type CastSet = Set.Set (Expr, Signing)
 
 type ST = StateT TypeMap (Writer CastSet)
 

src/Convert/UnpackedArray.hs

@@ -0,0 +1,103 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for any unpacked array which must be packed because it is: A) a
+ - port; B) is bound to a port; or C) is assigned a value in a single
+ - assignment.
+ -
+ - The scoped nature of declarations makes this challenging. While scoping is
+ - obeyed in general, any of a set of *equivalent* declarations within a module
+ - is packed, all of the declarations are packed. This is because we only record
+ - the declaration that needs to be packed when a relevant usage is encountered.
+ -}
+
+module Convert.UnpackedArray (convert) where
+
+import Control.Monad.State
+import Control.Monad.Writer
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+type DeclMap = Map.Map Identifier Decl
+type DeclSet = Set.Set Decl
+
+type ST = StateT DeclMap (Writer DeclSet)
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions convertDescription
+
+convertDescription :: Description -> Description
+convertDescription description =
+    traverseModuleItems (traverseDecls $ packDecl declsToPack) description'
+    where
+        (description', declsToPack) = runWriter $
+            scopedConversionM traverseDeclM traverseModuleItemM traverseStmtM
+            Map.empty description
+
+-- collects and converts multi-dimensional packed-array declarations
+traverseDeclM :: Decl -> ST Decl
+traverseDeclM (orig @ (Variable dir _ x _ me)) = do
+    modify $ Map.insert x orig
+    () <- if dir /= Local || me /= Nothing
+        then lift $ tell $ Set.singleton orig
+        else return ()
+    return orig
+traverseDeclM (orig @ (Param _ _ _ _)) =
+    return orig
+traverseDeclM (orig @ (ParamType _ _ _)) =
+    return orig
+
+-- pack the given decls marked for packing
+packDecl :: DeclSet -> Decl -> Decl
+packDecl decls (orig @ (Variable d t x a me)) = do
+    if Set.member orig decls
+        then do
+            let (tf, rs) = typeRanges t
+            let t' = tf $ a ++ rs
+            Variable d t' x [] me
+        else orig
+packDecl _ (orig @ Param{}) = orig
+packDecl _ (orig @ ParamType{}) = orig
+
+
+traverseModuleItemM :: ModuleItem -> ST ModuleItem
+traverseModuleItemM item =
+    traverseModuleItemM' item
+    >>= traverseLHSsM  traverseLHSM
+    >>= traverseExprsM traverseExprM
+
+traverseModuleItemM' :: ModuleItem -> ST ModuleItem
+traverseModuleItemM' (Instance a b c d bindings) = do
+    bindings' <- mapM collectBinding bindings
+    return $ Instance a b c d bindings'
+    where
+        collectBinding :: PortBinding -> ST PortBinding
+        collectBinding (y, Just (Ident x)) = do
+            flatUsageM x
+            return (y, Just (Ident x))
+        collectBinding other = return other
+traverseModuleItemM' other = return other
+
+traverseStmtM :: Stmt -> ST Stmt
+traverseStmtM stmt =
+    traverseStmtLHSsM  traverseLHSM  stmt >>=
+    traverseStmtExprsM traverseExprM
+
+traverseExprM :: Expr -> ST Expr
+traverseExprM = return
+
+traverseLHSM :: LHS -> ST LHS
+traverseLHSM (LHSIdent x) = do
+    flatUsageM x
+    return $ LHSIdent x
+traverseLHSM other = return other
+
+flatUsageM :: Identifier -> ST ()
+flatUsageM x = do
+    declMap <- get
+    case Map.lookup x declMap of
+        Just decl -> lift $ tell $ Set.singleton decl
+        Nothing -> return ()

src/Language/SystemVerilog/AST/Decl.hs

@@ -23,7 +23,7 @@ data Decl
     = Param     ParamScope Type Identifier Expr
     | ParamType ParamScope Identifier (Maybe Type)
     | Variable   Direction Type Identifier [Range] (Maybe Expr)
-    deriving Eq
+    deriving (Eq, Ord)
 
 instance Show Decl where
     showList l _ = unlines' $ map show l
@@ -36,7 +36,7 @@ data Direction
     | Output
     | Inout
     | Local
-    deriving Eq
+    deriving (Eq, Ord)
 
 instance Show Direction where
     show Input  = "input"
@@ -47,7 +47,7 @@ instance Show Direction where
 data ParamScope
     = Parameter
     | Localparam
-    deriving Eq
+    deriving (Eq, Ord)
 
 instance Show ParamScope where
     show Parameter  = "parameter"

sv2v.cabal

@@ -69,10 +69,10 @@ executable sv2v
     Convert.KWArgs
     Convert.Logic
     Convert.LogOp
+    Convert.MultiplePacked
     Convert.NamedBlock
     Convert.NestPI
     Convert.Package
-    Convert.PackedArray
     Convert.ParamType
     Convert.RemoveComments
     Convert.Return
@@ -82,10 +82,11 @@ executable sv2v
     Convert.StmtBlock
     Convert.Stream
     Convert.Struct
-    Convert.Typedef
     Convert.Traverse
+    Convert.Typedef
     Convert.UnbasedUnsized
     Convert.Unique
+    Convert.UnpackedArray
     Convert.Unsigned
     -- sv2v CLI modules
     Job

test/basic/packed_array.sv

@@ -0,0 +1,14 @@
+module top;
+    logic [2:0][3:0] arr [1:0];
+    initial begin
+        for (int i = 0; i <= 1; i++) begin
+            for (int j = 0; j <= 2; j++) begin
+                for (int k = 0; k <= 3; k++) begin
+                    $display("%b", arr[i][j][k]);
+                    arr[i][j][k] = 1'(i+j+k);
+                    $display("%b", arr[i][j][k]);
+                end
+            end
+        end
+    end
+endmodule

test/basic/packed_array.v

@@ -0,0 +1,15 @@
+module top;
+    reg arr [1:0][2:0][3:0];
+    initial begin : block_name
+        integer i, j, k;
+        for (i = 0; i <= 1; i++) begin
+            for (j = 0; j <= 2; j++) begin
+                for (k = 0; k <= 3; k++) begin
+                    $display("%b", arr[i][j][k]);
+                    arr[i][j][k] = i+j+k;
+                    $display("%b", arr[i][j][k]);
+                end
+            end
+        end
+    end
+endmodule

test/lib/functions.sh

@@ -60,8 +60,6 @@ assertConverts() {
     PATTERNS="\$bits\|\$dimensions\|\$unpacked_dimensions\|\$left\|\$right\|\$low\|\$high\|\$increment\|\$size"
     echo "$filtered" | grep "$PATTERNS" > /dev/null
     assertFalse "conversion of $ac_file still contains dimension queries" $?
-    echo "$filtered" | grep "\]\[" > /dev/null
-    assertFalse "conversion of $ac_file still contains multi-dim arrays" $?
     echo "$filtered" | egrep "\s(int\|bit\|logic\|byte\|struct\|enum\|longint\|shortint)\s"
     assertFalse "conversion of $ac_file still contains SV types" $?
     echo "$filtered" | grep "[^$]unsigned" > /dev/null