conversion of structs with multi-dim fields (resolves #53)

src/Convert/MultiplePacked.hs

@@ -33,7 +33,8 @@ import qualified Data.Map.Strict as Map
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type Info = Map.Map Identifier ([Range], [Range])
+type TypeInfo = (Type, [Range])
+type Info = Map.Map Identifier TypeInfo
 
 convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
@@ -55,16 +56,27 @@ traverseDeclM (ParamType s ident mt) =
 
 traverseTypeM :: Type -> [Range] -> Identifier -> State Info Type
 traverseTypeM t a ident = do
-    let (tf, rs) = typeRanges t
+    modify $ Map.insert ident (t, a)
+    t' <- case t of
+        Struct pk fields rs -> do
+            fields' <- flattenFields fields
+            return $ Struct pk fields' rs
+        Union  pk fields rs -> do
+            fields' <- flattenFields fields
+            return $ Union  pk fields' rs
+        _ -> return t
+    let (tf, rs) = typeRanges t'
     if length rs <= 1
-        then do
-            modify $ Map.delete ident
-            return t
+        then return t'
         else do
-            modify $ Map.insert ident (rs, a)
             let r1 : r2 : rest = rs
             let rs' = (combineRanges r1 r2) : rest
             return $ tf rs'
+    where
+        flattenFields fields = do
+            let (fieldTypes, fieldNames) = unzip fields
+            fieldTypes' <- mapM (\x -> traverseTypeM x [] "") fieldTypes
+            return $ zip fieldTypes' fieldNames
 
 -- combines two ranges into one flattened range
 combineRanges :: Range -> Range -> Range
@@ -110,33 +122,46 @@ traverseLHSM lhs = do
     return $ fromJust $ exprToLHS expr'
 
 traverseExpr :: Info -> Expr -> Expr
-traverseExpr typeDims =
+traverseExpr typeMap =
     rewriteExpr
     where
-        -- 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)
-
-        -- given an expression, returns the packed and unpacked dimensions and a
-        -- tagged version of the expression, if possible
-        levels :: Expr -> Maybe ([Range], [Range], Expr)
+        -- removes the innermost dimensions of the given type information, and
+        -- applies the given transformation to the expression
+        dropLevel :: (Expr -> Expr) -> (TypeInfo, Expr) -> (TypeInfo, Expr)
+        dropLevel nest ((t, a), expr) =
+            ((tf rs', a'), nest expr)
+            where
+                (tf, rs) = typeRanges t
+                (rs', a') = case (rs, a) of
+                    ([], []) -> ([], [])
+                    (packed, []) -> (tail packed, [])
+                    (packed, unpacked) -> (packed, tail unpacked)
+
+        -- given an expression, returns its type information and a tagged
+        -- version of the expression, if possible
+        levels :: Expr -> Maybe (TypeInfo, Expr)
         levels (Ident x) =
-            case Map.lookup x typeDims of
-                Just (a, b) -> Just (a, b, Ident $ tag : x)
+            case Map.lookup x typeMap of
+                Just a -> Just (a, 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 (Dot expr x) =
+            case levels expr of
+                Just ((Struct _ fields [], []), expr') -> dropDot fields expr'
+                Just ((Union  _ fields [], []), expr') -> dropDot fields expr'
+                _ -> Nothing
+            where
+                dropDot :: [Field] -> Expr -> Maybe (TypeInfo, Expr)
+                dropDot fields expr' =
+                    if Map.member x fieldMap
+                        then Just ((fieldType, []), Dot expr' x)
+                        else Nothing
+                    where
+                        fieldMap = Map.fromList $ map swap fields
+                        fieldType = fieldMap Map.! x
         levels _ = Nothing
 
         -- given an expression, returns the two innermost packed dimensions and a
@@ -144,9 +169,12 @@ traverseExpr typeDims =
         dims :: Expr -> Maybe (Range, Range, Expr)
         dims expr =
             case levels expr of
-                Just (dimInner : dimOuter : _, [], expr') ->
+                Just ((t, []), expr') ->
+                    case snd $ typeRanges t of
+                        dimInner : dimOuter : _ ->
                             Just (dimInner, dimOuter, expr')
                         _ -> Nothing
+                _ -> Nothing
 
         -- if the given range is flipped, the result will flip around the given
         -- indexing expression

src/Convert/Struct.hs

@@ -97,7 +97,10 @@ collectStructM' constructor isStruct sg fields = do
         zero = Number "0"
         typeRange :: Type -> Range
         typeRange t =
-            if null ranges then (zero, zero) else head ranges
+            case ranges of
+                [] -> (zero, zero)
+                [range] -> range
+                _ -> error "Struct.hs invariant failure"
             where ranges = snd $ typeRanges t
 
         -- extract info about the fields
@@ -132,13 +135,13 @@ collectStructM' constructor isStruct sg fields = do
         packedRange = (simplify $ BinOp Sub structSize (Number "1"), zero)
         unstructType = IntegerVector TLogic sg [packedRange]
 
-        -- check if this struct can be packed into an integer vector; integer
-        -- atoms and non-integers do not have a definitive size, and so cannot
-        -- be packed; net types are not permitted as struct fields
-        isIntVec :: Type -> Bool
-        isIntVec (IntegerVector _ _ _) = True
-        isIntVec _ = False
-        canUnstructure = all isIntVec fieldTypes
+        -- check if this struct can be packed into an integer vector; we only
+        -- pack flat integer vector types; the fields will be flattened and
+        -- converted by other phases
+        isFlatIntVec :: Type -> Bool
+        isFlatIntVec (IntegerVector _ _ rs) = length rs <= 1
+        isFlatIntVec _ = False
+        canUnstructure = all isFlatIntVec fieldTypes
 
 
 -- convert a struct type to its unstructured equivalent
@@ -221,6 +224,13 @@ packerFnName :: TypeFunc -> Identifier
 packerFnName structTf =
     "sv2v_struct_" ++ shortHash structTf
 
+-- removes the innermost range from the given type, if possible
+dropInnerTypeRange :: Type -> Type
+dropInnerTypeRange t =
+    case typeRanges t of
+        (_, []) -> Implicit Unspecified []
+        (tf, rs) -> tf $ tail rs
+
 -- This is where the magic happens. This is responsible for converting struct
 -- accesses, assignments, and literals, given appropriate information about the
 -- structs and the current declaration context. The general strategy involves
@@ -249,9 +259,7 @@ convertAsgn structs types (lhs, expr) =
                 _ -> (t', LHSBit l' e)
             where
                 (t, l') = convertLHS l
-                t' = case typeRanges t of
-                    (_, []) -> Implicit Unspecified []
-                    (tf, rs) -> tf $ tail rs
+                t' = dropInnerTypeRange t
         convertLHS (LHSRange lOuter NonIndexed rOuter) =
             case lOuter' of
                 LHSRange lInner NonIndexed (_, loI) ->
@@ -268,13 +276,23 @@ convertAsgn structs types (lhs, expr) =
             where
                 (hiO, loO) = rOuter
                 (t, lOuter') = convertLHS lOuter
+        convertLHS (LHSRange lOuter IndexedPlus (rOuter @ (baseO, lenO))) =
+            case lOuter' of
+                LHSRange lInner NonIndexed (hiI, loI) ->
+                    (t', LHSRange lInner IndexedPlus (simplify base, simplify len))
+                    where
+                        base = BinOp Add baseO $
+                            endianCondExpr (hiI, loI) loI hiI
+                        len = lenO
+                _ -> (t', LHSRange lOuter' IndexedPlus rOuter)
+            where
+                (t, lOuter') = convertLHS lOuter
+                t' = dropInnerTypeRange t
         convertLHS (LHSRange l m r) =
             (t', LHSRange l' m r)
             where
                 (t, l') = convertLHS l
-                t' = case typeRanges t of
-                    (_, []) -> Implicit Unspecified []
-                    (tf, rs) -> tf $ tail rs
+                t' = dropInnerTypeRange t
         convertLHS (LHSDot    l x ) =
             case t of
                 InterfaceT _ _ _ -> (Implicit Unspecified [], LHSDot l' x)
@@ -421,24 +439,36 @@ convertAsgn structs types (lhs, expr) =
             -- semantics are that a range returns a new, zero-indexed sub-range.
             case eOuter' of
                 Range eInner NonIndexed (_, loI) ->
-                    (t, Range eInner NonIndexed (simplify hi, simplify lo))
+                    (t', Range eInner NonIndexed (simplify hi, simplify lo))
                     where
                         lo = BinOp Add loI loO
                         hi = BinOp Add loI hiO
                 Range eInner IndexedPlus (baseI, _) ->
-                    (t, Range eInner IndexedPlus (simplify base, simplify len))
+                    (t', Range eInner IndexedPlus (simplify base, simplify len))
                     where
                         base = BinOp Add baseI loO
                         len = rangeSize rOuter
-                _ -> (t, Range eOuter' NonIndexed rOuter)
-            where (t, eOuter') = convertSubExpr eOuter
+                _ -> (t', Range eOuter' NonIndexed rOuter)
+            where
+                (t, eOuter') = convertSubExpr eOuter
+                t' = dropInnerTypeRange t
+        convertSubExpr (Range eOuter IndexedPlus (rOuter @ (baseO, lenO))) =
+            case eOuter' of
+                Range eInner NonIndexed (hiI, loI) ->
+                    (t', Range eInner IndexedPlus (simplify base, simplify len))
+                    where
+                        base = BinOp Add baseO $
+                            endianCondExpr (hiI, loI) loI hiI
+                        len = lenO
+                _ -> (t', Range eOuter' IndexedPlus rOuter)
+            where
+                (t, eOuter') = convertSubExpr eOuter
+                t' = dropInnerTypeRange t
         convertSubExpr (Range e m r) =
             (t', Range e' m r)
             where
                 (t, e') = convertSubExpr e
-                t' = case typeRanges t of
-                    (_, []) -> Implicit Unspecified []
-                    (tf, rs) -> tf $ tail rs
+                t' = dropInnerTypeRange t
         convertSubExpr (Concat exprs) =
             (Implicit Unspecified [], Concat $ map (snd . convertSubExpr) exprs)
         convertSubExpr (Stream o e exprs) =
@@ -460,9 +490,7 @@ convertAsgn structs types (lhs, expr) =
                 _ -> (t', Bit e' i')
             where
                 (t, e') = convertSubExpr e
-                t' = case typeRanges t of
-                    (_, []) -> Implicit Unspecified []
-                    (tf, rs) -> tf $ tail rs
+                t' = dropInnerTypeRange t
                 (_, i') = convertSubExpr i
         convertSubExpr (Call e args) =
             (retType, Call e $ convertCall structs types e' args)

test/basic/flatten_tb.v

@@ -35,5 +35,8 @@ module top;
     `FOO(B)
     `FOO(C)
     `FOO(D)
+    `FOO(E)
+    `FOO(F)
+    `FOO(G)
 
 endmodule

test/basic/struct_array_field.sv

+module main;
+    typedef struct packed {
+        logic [1:0][2:0] x;
+        logic [0:2][1:0] y;
+        logic z;
+    } foo_t;
+    foo_t foo;
+
+    initial begin
+        $monitor($time, " %b %b %b %b %b %b %b %b",
+            foo, foo.x, foo.y, foo.z,
+            foo.x[0], foo.x[0][0], foo.y[0], foo.y[0][0]);
+
+        #1; foo.z = 0;
+
+        #1; foo.y = 0;
+        #1; foo.y[0] = '1;
+        #1; foo.y[1] = '1;
+        #1; foo.y[1][1] = 0;
+        #1; foo.y[0][0] = 1;
+        #1; foo.y[0][1] = 1;
+
+        #1; foo.x = 0;
+        #1; foo.x[0] = '1;
+        #1; foo.x[1] = '1;
+        #1; foo.x[1][1] = 0;
+        #1; foo.x[0][0] = 1;
+        #1; foo.x[0][1] = 1;
+
+    end
+endmodule
+
+module top;
+endmodule

test/basic/struct_array_field.v

+module main;
+    reg [2:0] foo_x_1;
+    reg [2:0] foo_x_0;
+    reg [1:0] foo_y_2;
+    reg [1:0] foo_y_1;
+    reg [1:0] foo_y_0;
+    wire [5:0] foo_x;
+    wire [5:0] foo_y;
+    assign foo_x = {foo_x_1, foo_x_0};
+    assign foo_y = {foo_y_0, foo_y_1, foo_y_2};
+    reg foo_z;
+    wire [12:0] foo;
+    assign foo = {foo_x, foo_y, foo_z};
+
+    initial begin
+        $monitor($time, " %b %b %b %b %b %b %b %b",
+            foo, foo_x, foo_y, foo_z,
+            foo_x_0, foo_x_0[0], foo_y_0, foo_y_0[0]);
+
+        #1; foo_z = 0;
+
+        #1; {foo_y_0, foo_y_1, foo_y_2} = 0;
+        #1; foo_y_0 = 1'sb1;
+        #1; foo_y_1 = 1'sb1;
+        #1; foo_y_1[1] = 0;
+        #1; foo_y_0[0] = 1;
+        #1; foo_y_0[1] = 1;
+
+        #1; {foo_x_1, foo_x_0} = 0;
+        #1; foo_x_0 = 1'sb1;
+        #1; foo_x_1 = 1'sb1;
+        #1; foo_x_1[1] = 0;
+        #1; foo_x_0[0] = 1;
+        #1; foo_x_0[1] = 1;
+
+    end
+endmodule
+
+module top;
+endmodule