From 6743725cca25348097ce0099c323cdd930805035 Mon Sep 17 00:00:00 2001
From: Zachary Snow <zach@zachjs.com>
Date: Sat, 19 Jun 2021 18:45:35 -0400
Subject: [PATCH] support partial packing of multidimensional unpacked arrays

---
 src/Convert/UnpackedArray.hs       | 59 ++++++++++++++++++++----------
 test/basic/unpacked_array_depth.sv | 18 +++++++++
 test/basic/unpacked_array_depth.v  | 18 +++++++++
 3 files changed, 75 insertions(+), 20 deletions(-)
 create mode 100644 test/basic/unpacked_array_depth.sv
 create mode 100644 test/basic/unpacked_array_depth.v

diff --git a/src/Convert/UnpackedArray.hs b/src/Convert/UnpackedArray.hs
index 918a6cc..0239759 100644
--- a/src/Convert/UnpackedArray.hs
+++ b/src/Convert/UnpackedArray.hs
@@ -1,28 +1,25 @@
+{-# LANGUAGE FlexibleInstances #-}
 {- 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; C) is assigned a value in a single assignment;
- - or D) is assigned to an unpacked array which itself must be packed.
- -
- - The scoped nature of declarations makes this challenging. While scoping is
- - obeyed in general, if 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.
+ - or D) is assigned to an unpacked array which itself must be packed. The
+ - conversion allows for an array to be partially packed if all flat usages of
+ - the array explicitly specify some of the unpacked dimensions.
  -}
 
 module Convert.UnpackedArray (convert) where
 
 import Control.Monad.State.Strict
-import qualified Data.Set as Set
+import qualified Data.Map.Strict as Map
 
 import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
 type Location = [Identifier]
-type Locations = Set.Set Location
+type Locations = Map.Map Location Int
 type ST = ScoperT Decl (State Locations)
 
 convert :: [AST] -> [AST]
@@ -30,7 +27,7 @@ convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
 convertDescription (description @ (Part _ _ Module _ _ ports _)) =
-    evalState (operation description) Set.empty
+    evalState (operation description) Map.empty
     where
         operation = partScoperT
             (traverseDeclM ports) traverseModuleItemM noop traverseStmtM >=>
@@ -57,13 +54,14 @@ rewriteDeclM (decl @ (Variable d t x a e)) = do
     details <- lookupElemM x
     let Just (accesses, _, _) = details
     let location = map accessName accesses
-    usedAsPacked <- lift $ gets $ Set.member location
-    if usedAsPacked
-        then do
+    usedAsPacked <- lift $ gets $ Map.lookup location
+    case usedAsPacked of
+        Just depth -> do
             let (tf, rs) = typeRanges t
-            let t' = tf $ a ++ rs
-            return $ Variable d t' x [] e
-        else return decl
+            let (shifted, rest) = splitAt (length a - depth) a
+            let t' = tf $ shifted ++ rs
+            return $ Variable d t' x rest e
+        Nothing -> return decl
 rewriteDeclM other = return other
 
 traverseModuleItemM :: ModuleItem -> ST ModuleItem
@@ -109,11 +107,32 @@ traverseAsgnM (x, y) = do
     flatUsageM y
     return (x, y)
 
-flatUsageM :: ScopeKey e => e -> ST ()
-flatUsageM x = do
-    details <- lookupElemM x
+class ScopeKey t => Key t where
+    unbit :: t -> (t, Int)
+
+instance Key Expr where
+    unbit (Bit e _) = (e', n + 1)
+        where (e', n) = unbit e
+    unbit (Range e _ _) = (e', n)
+        where (e', n) = unbit e
+    unbit e = (e, 0)
+
+instance Key LHS where
+    unbit (LHSBit e _) = (e', n + 1)
+        where (e', n) = unbit e
+    unbit (LHSRange e _ _) = (e', n)
+        where (e', n) = unbit e
+    unbit e = (e, 0)
+
+instance Key Identifier where
+    unbit x = (x, 0)
+
+flatUsageM :: Key k => k -> ST ()
+flatUsageM k = do
+    let (k', depth) = unbit k
+    details <- lookupElemM k'
     case details of
         Just (accesses, _, _) -> do
             let location = map accessName accesses
-            lift $ modify $ Set.insert location
+            lift $ modify $ Map.insertWith min location depth
         Nothing -> return ()
diff --git a/test/basic/unpacked_array_depth.sv b/test/basic/unpacked_array_depth.sv
new file mode 100644
index 0000000..64131b9
--- /dev/null
+++ b/test/basic/unpacked_array_depth.sv
@@ -0,0 +1,18 @@
+module example(
+    input wire [7:0] inp,
+    output wire [7:0] out
+);
+    assign out = ~inp;
+endmodule
+
+module top;
+    reg arr1 [7:0][1:0];
+    reg arr2 [7:0][1:0][1:0];
+    wire [7:0] out1, out2;
+    example e1(arr1[0], out1);
+    example e2(arr2[0][0], out2);
+    initial begin
+        #1 arr1[0] = 8'hAD;
+        #1 arr2[0][0] = 8'h42;
+    end
+endmodule
diff --git a/test/basic/unpacked_array_depth.v b/test/basic/unpacked_array_depth.v
new file mode 100644
index 0000000..bcaac09
--- /dev/null
+++ b/test/basic/unpacked_array_depth.v
@@ -0,0 +1,18 @@
+module example(
+    input wire [7:0] inp,
+    output wire [7:0] out
+);
+    assign out = ~inp;
+endmodule
+
+module top;
+    reg [7:0] arr1 [1:0];
+    reg [7:0] arr2 [1:0][1:0];
+    wire [7:0] out1, out2;
+    example e1(arr1[0], out1);
+    example e2(arr2[0][0], out2);
+    initial begin
+        #1 arr1[0] = 8'hAD;
+        #1 arr2[0][0] = 8'h42;
+    end
+endmodule