diff --git a/src/Convert/ParamType.hs b/src/Convert/ParamType.hs index e4cafba..b9621ea 100644 --- a/src/Convert/ParamType.hs +++ b/src/Convert/ParamType.hs @@ -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 diff --git a/test/basic/paramtype_delay.sv b/test/basic/paramtype_delay.sv new file mode 100644 index 0000000..60f78bd --- /dev/null +++ b/test/basic/paramtype_delay.sv @@ -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 diff --git a/test/basic/paramtype_delay.v b/test/basic/paramtype_delay.v new file mode 100644 index 0000000..6f75aa3 --- /dev/null +++ b/test/basic/paramtype_delay.v @@ -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