Commit 95299c6f by Zachary Snow

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

parent 49e4f787
......@@ -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,8 +169,11 @@ traverseExpr typeDims =
dims :: Expr -> Maybe (Range, Range, Expr)
dims expr =
case levels expr of
Just (dimInner : dimOuter : _, [], expr') ->
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
......
......@@ -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)
......
......@@ -35,5 +35,8 @@ module top;
`FOO(B)
`FOO(C)
`FOO(D)
`FOO(E)
`FOO(F)
`FOO(G)
endmodule
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
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment