mirror of https://github.com/zachjs/sv2v.git
fix param type default pollution
This commit is contained in:
parent
84986cc197
commit
36fcce8934
|
|
@ -9,7 +9,7 @@ module Convert.ParamType (convert) where
|
|||
|
||||
import Control.Monad.Writer.Strict
|
||||
import Data.Either (isLeft)
|
||||
import Data.Maybe (isJust, isNothing, fromJust)
|
||||
import Data.Maybe (isJust, fromJust)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
|
@ -44,18 +44,16 @@ convert files =
|
|||
else
|
||||
(:) part $
|
||||
filter (not . alreadyExists) $
|
||||
filter isNonDefault $
|
||||
map (rewriteModule part) theseInstances
|
||||
where
|
||||
theseInstances = map snd $ filter ((== name) . fst) instances
|
||||
isNonDefault = (name /=) . moduleName
|
||||
alreadyExists = (flip Map.member info) . moduleName
|
||||
moduleName :: Description -> Identifier
|
||||
moduleName = \(Part _ _ _ _ x _ _) -> x
|
||||
explodeDescription other = [other]
|
||||
|
||||
-- remove or rewrite source modules that are no longer needed
|
||||
files''' = map (\a -> concatMap (replaceDefault a) a) files''
|
||||
-- remove source modules that are no longer needed
|
||||
files''' = map (filter keepDescription) files''
|
||||
(usageMapRaw, usedTypedModulesRaw) =
|
||||
execWriter $ mapM (mapM collectUsageInfoM) files''
|
||||
usageMap = Map.unionsWith Set.union $ map (uncurry Map.singleton)
|
||||
|
|
@ -80,42 +78,13 @@ convert files =
|
|||
then tell (Set.empty, Set.singleton m)
|
||||
else tell (Set.singleton m, Set.empty)
|
||||
collectModuleItemM _ = return ()
|
||||
replaceDefault :: [Description] -> Description -> [Description]
|
||||
replaceDefault existing (part @ (Part _ _ _ _ name _ _)) =
|
||||
if Map.notMember name info then
|
||||
[part]
|
||||
else if Map.null maybeTypeMap then
|
||||
[part]
|
||||
else if Map.member name usedTypedModules && isUsed name then
|
||||
[part]
|
||||
else if all isNothing maybeTypeMap then
|
||||
[]
|
||||
else
|
||||
filter (not . alreadyExists) $
|
||||
(:) (removeDefaultTypeParams part) $
|
||||
if isNothing typeMap
|
||||
then []
|
||||
else [rewriteModule part $ fromJust typeMap]
|
||||
where
|
||||
maybeTypeMap = info Map.! name
|
||||
typeMap = defaultInstance maybeTypeMap
|
||||
existingNames = map moduleName existing
|
||||
alreadyExists = (flip elem existingNames) . moduleName
|
||||
moduleName :: Description -> Identifier
|
||||
moduleName (Part _ _ _ _ x _ _) = x
|
||||
moduleName _ = ""
|
||||
replaceDefault _ other = [other]
|
||||
|
||||
removeDefaultTypeParams :: Description -> Description
|
||||
removeDefaultTypeParams part =
|
||||
Part attrs extern kw ml (moduleDefaultName name) p items
|
||||
where
|
||||
Part attrs extern kw ml name p items =
|
||||
traverseModuleItems (traverseDecls rewriteDecl) part
|
||||
rewriteDecl :: Decl -> Decl
|
||||
rewriteDecl (ParamType Parameter x _) =
|
||||
ParamType Parameter x UnknownType
|
||||
rewriteDecl other = other
|
||||
keepDescription :: Description -> Bool
|
||||
keepDescription (Part _ _ _ _ name _ _) =
|
||||
Map.notMember name info ||
|
||||
Map.null maybeTypeMap ||
|
||||
(Map.member name usedTypedModules && isUsed name)
|
||||
where maybeTypeMap = info Map.! name
|
||||
keepDescription _ = True
|
||||
|
||||
isUsed :: Identifier -> Bool
|
||||
isUsed name =
|
||||
|
|
@ -150,9 +119,11 @@ convert files =
|
|||
rewriteModuleItem = traverseNestedModuleItems $ traverseNodes
|
||||
rewriteExpr rewriteDecl rewriteType rewriteLHS rewriteStmt
|
||||
rewriteDecl :: Decl -> Decl
|
||||
rewriteDecl (ParamType Parameter x _) =
|
||||
ParamType Localparam x t
|
||||
where t = rewriteType $ fst $ typeMap Map.! x
|
||||
rewriteDecl (ParamType Parameter x t) =
|
||||
ParamType Localparam x $ rewriteType $
|
||||
case Map.lookup x typeMap of
|
||||
Nothing -> t
|
||||
Just (t', _) -> t'
|
||||
rewriteDecl other =
|
||||
traverseDeclTypes rewriteType $
|
||||
traverseDeclExprs rewriteExpr other
|
||||
|
|
@ -219,26 +190,10 @@ collectDescriptionM (part @ (Part _ _ _ _ name _ _)) =
|
|||
collectDeclM _ = return ()
|
||||
collectDescriptionM _ = return ()
|
||||
|
||||
-- produces the default type mapping of a module, if there is one
|
||||
defaultInstance :: MaybeTypeMap -> Maybe Instance
|
||||
defaultInstance maybeTypeMap =
|
||||
if any isNothing maybeTypeMap
|
||||
then Nothing
|
||||
else Just $ Map.map ((, Set.empty) . fromJust) maybeTypeMap
|
||||
|
||||
-- generate a "unique" name for a particular module type instance
|
||||
moduleInstanceName :: Identifier -> Instance -> Identifier
|
||||
moduleInstanceName m inst = m ++ "_" ++ shortHash (m, inst)
|
||||
|
||||
-- name for the module without any default type parameters
|
||||
moduleDefaultName :: Identifier -> Identifier
|
||||
moduleDefaultName m = m ++ defaultTag
|
||||
isDefaultName :: Identifier -> Bool
|
||||
isDefaultName m =
|
||||
defaultTag == (reverse $ (take $ length defaultTag) $ reverse m)
|
||||
defaultTag :: Identifier
|
||||
defaultTag = "_sv2v_default"
|
||||
|
||||
-- checks where a type is sufficiently resolved to be substituted
|
||||
isSimpleType :: Type -> Bool
|
||||
isSimpleType typ =
|
||||
|
|
@ -301,12 +256,8 @@ convertModuleItemM info (orig @ (Instance m bindings x r p)) =
|
|||
else if any (isLeft . snd) bindings' then
|
||||
error $ "param type resolution left type params: " ++ show orig
|
||||
++ " converted to: " ++ show bindings'
|
||||
else if any (not . isSimpleType . fst) resolvedTypes then do
|
||||
let defaults = Map.map (Left . fst) resolvedTypes
|
||||
let bindingsDefaulted = Map.toList $ Map.union bindingsMap defaults
|
||||
if isDefaultName m || bindingsDefaulted == Map.toList bindingsMap
|
||||
then return $ Instance m bindings x r p
|
||||
else return $ Instance (moduleDefaultName m) bindingsDefaulted x r p
|
||||
else if any (not . isSimpleType . fst) resolvedTypes then
|
||||
return orig
|
||||
else do
|
||||
tell $ Set.singleton (m, resolvedTypes)
|
||||
let m' = moduleInstanceName m resolvedTypes
|
||||
|
|
@ -317,17 +268,14 @@ convertModuleItemM info (orig @ (Instance m bindings x r p)) =
|
|||
maybeTypeMap = info Map.! m
|
||||
-- determine the types corresponding to each type parameter
|
||||
bindingsMap = Map.fromList bindings
|
||||
resolvedTypesWithDecls = Map.mapWithKey resolveType maybeTypeMap
|
||||
resolvedTypesWithDecls = Map.mapMaybeWithKey resolveType bindingsMap
|
||||
resolvedTypes = Map.map (\(a, (b, _)) -> (a, b)) resolvedTypesWithDecls
|
||||
addedDecls = concatMap (snd . snd . snd) $
|
||||
Map.toList resolvedTypesWithDecls
|
||||
resolveType :: Identifier -> Maybe Type -> (Type, (IdentSet, [Decl]))
|
||||
resolveType paramName defaultType =
|
||||
case Map.lookup paramName bindingsMap of
|
||||
Nothing -> (t, (Set.empty, []))
|
||||
where Just t = defaultType
|
||||
Just b -> prepareTypeExprs x paramName t
|
||||
where Left t = b
|
||||
resolveType :: Identifier -> TypeOrExpr -> Maybe (Type, (IdentSet, [Decl]))
|
||||
resolveType _ Right{} = Nothing
|
||||
resolveType paramName (Left t) =
|
||||
Just $ prepareTypeExprs x paramName t
|
||||
|
||||
-- leave only the normal expression params behind
|
||||
isParamType = flip Map.member maybeTypeMap
|
||||
|
|
|
|||
|
|
@ -0,0 +1,32 @@
|
|||
module mod #(
|
||||
parameter STR = "",
|
||||
parameter type T = logic,
|
||||
parameter WIDTH = 32,
|
||||
parameter type WIDTH_T = logic [WIDTH-1:0],
|
||||
parameter T INDIRECT = 0,
|
||||
parameter type OTHER_T = struct packed { type(INDIRECT) x, y; }
|
||||
);
|
||||
initial begin
|
||||
$display("%s $bits(T) = %0d", STR, $bits(T));
|
||||
$display("%s WIDTH = %0d", STR, WIDTH);
|
||||
$display("%s $bits(WIDTH_T) = %0d", STR, $bits(WIDTH_T));
|
||||
$display("%s $bits(OTHER_T) = %0d", STR, $bits(OTHER_T));
|
||||
end
|
||||
endmodule
|
||||
|
||||
module top;
|
||||
typedef struct packed { byte y; } W;
|
||||
W w;
|
||||
typedef struct packed { type(w) x, y; } V;
|
||||
V v;
|
||||
typedef logic [$bits(v)*2-1:0] U;
|
||||
U u;
|
||||
|
||||
`define TEST(x) \
|
||||
assign x = 0; \
|
||||
mod #(`"x`", type(x)) m``x();
|
||||
`TEST(w)
|
||||
`TEST(v)
|
||||
`TEST(u)
|
||||
mod #("t") mt();
|
||||
endmodule
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
module mod #(
|
||||
parameter STR = "",
|
||||
parameter T = 1
|
||||
);
|
||||
initial begin
|
||||
$display("%s $bits(T) = %0d", STR, T);
|
||||
$display("%s WIDTH = %0d", STR, 32);
|
||||
$display("%s $bits(WIDTH_T) = %0d", STR, 32);
|
||||
$display("%s $bits(OTHER_T) = %0d", STR, 2 * T);
|
||||
end
|
||||
endmodule
|
||||
|
||||
module top;
|
||||
`define TEST(x, w) \
|
||||
wire [w-1:0] x; \
|
||||
assign x = 0; \
|
||||
mod #(`"x`", w) m``x();
|
||||
`TEST(w, 8)
|
||||
`TEST(v, 16)
|
||||
`TEST(u, 32)
|
||||
mod #("t") mt();
|
||||
endmodule
|
||||
Loading…
Reference in New Issue