mirror of https://github.com/zachjs/sv2v.git
additional param type conversion bug fixes
- general refactoring throughout - improved metrics for dropping unneeded modules - fix re-visiting a converted instance in the same pass
This commit is contained in:
Zachary Snow
parent
003d4dbc4e
commit
a87ee7c11b
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{- sv2v
|
||||
- Author: Zachary Snow <zach@zachjs.com>
|
||||
|
|
@ -8,15 +9,15 @@
|
|||
module Convert.ParamType (convert) where
|
||||
|
||||
import Control.Monad.Writer.Strict
|
||||
import Data.Either (isRight)
|
||||
import Data.Either (isRight, lefts)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Convert.Traverse
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
type MaybeTypeMap = Map.Map Identifier (Maybe Type)
|
||||
type Info = Map.Map Identifier MaybeTypeMap
|
||||
type TypeMap = Map.Map Identifier Type
|
||||
type Modules = Map.Map Identifier TypeMap
|
||||
|
||||
type Instance = Map.Map Identifier (Type, IdentSet)
|
||||
type Instances = Set.Set (Identifier, Instance)
|
||||
|
|
@ -28,106 +29,123 @@ convert :: [AST] -> [AST]
|
|||
convert files =
|
||||
files'''
|
||||
where
|
||||
info = execWriter $
|
||||
modules = execWriter $
|
||||
mapM (collectDescriptionsM collectDescriptionM) files
|
||||
(files', instancesRaw) = runWriter $ mapM
|
||||
(mapM $ traverseModuleItemsM $ convertModuleItemM info) files
|
||||
(files', instancesRaw) =
|
||||
runWriter $ mapM (mapM convertDescriptionM) files
|
||||
instances = Set.toList instancesRaw
|
||||
|
||||
-- add type parameter instantiations
|
||||
files'' = map (concatMap explodeDescription) files'
|
||||
explodeDescription :: Description -> [Description]
|
||||
explodeDescription (part @ (Part _ _ _ _ name _ _)) =
|
||||
if null theseInstances then
|
||||
[part]
|
||||
else
|
||||
(:) part $
|
||||
filter (not . alreadyExists) $
|
||||
map (rewriteModule part) theseInstances
|
||||
(part :) $
|
||||
filter (not . alreadyExists) $
|
||||
map (rewriteModule part) theseInstances
|
||||
where
|
||||
theseInstances = map snd $ filter ((== name) . fst) instances
|
||||
alreadyExists = (flip Map.member info) . moduleName
|
||||
alreadyExists = flip Map.member modules . moduleName
|
||||
moduleName :: Description -> Identifier
|
||||
moduleName = \(Part _ _ _ _ x _ _) -> x
|
||||
explodeDescription other = [other]
|
||||
|
||||
-- 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)
|
||||
usageMapRaw
|
||||
usedTypedModules = Map.unionsWith Set.union $ map (uncurry
|
||||
Map.singleton) usedTypedModulesRaw
|
||||
collectUsageInfoM :: Description -> Writer (UsageMap, UsageMap) ()
|
||||
collectUsageInfoM (part @ (Part _ _ _ _ name _ _)) =
|
||||
tell (makeList used, makeList usedTyped)
|
||||
where
|
||||
makeList s = zip (Set.toList s) (repeat $ Set.singleton name)
|
||||
(usedUntyped, usedTyped) =
|
||||
execWriter $ (collectModuleItemsM collectModuleItemM) part
|
||||
used = Set.union usedUntyped usedTyped
|
||||
collectUsageInfoM _ = return ()
|
||||
-- remove or reduce source modules that are no longer needed
|
||||
files''' = map (map reduceTypeDefaults . filter keepDescription) files''
|
||||
-- produce a typed and untyped instantiation graph
|
||||
(usedUntypedModules, usedTypedModules) =
|
||||
both (Map.fromListWith Set.union) $
|
||||
execWriter $ mapM (mapM collectUsageM) files''
|
||||
collectUsageM :: Description -> Writer (UsageMap, UsageMap) ()
|
||||
collectUsageM (part @ (Part _ _ _ _ name _ _)) =
|
||||
tell $ both makeList $ execWriter $
|
||||
(collectModuleItemsM collectModuleItemM) part
|
||||
where makeList s = zip (Set.toList s) (repeat $ Set.singleton name)
|
||||
collectUsageM _ = return ()
|
||||
collectModuleItemM :: ModuleItem -> Writer (IdentSet, IdentSet) ()
|
||||
collectModuleItemM (Instance m bindings _ _ _) = do
|
||||
case Map.lookup m info of
|
||||
Nothing -> tell (Set.singleton m, Set.empty)
|
||||
Just maybeTypeMap ->
|
||||
if any (flip Map.member maybeTypeMap) $ map fst bindings
|
||||
then tell (Set.empty, Set.singleton m)
|
||||
else tell (Set.singleton m, Set.empty)
|
||||
collectModuleItemM (Instance m bindings _ _ _) =
|
||||
if all (isRight . snd) bindings
|
||||
then tell (Set.singleton m, Set.empty)
|
||||
else tell (Set.empty, Set.singleton m)
|
||||
collectModuleItemM _ = return ()
|
||||
both f (x, y) = (f x, f y) -- simple tuple map helper
|
||||
|
||||
-- identify if a module is still in use
|
||||
keepDescription :: Description -> Bool
|
||||
keepDescription (Part _ _ _ _ name _ _) =
|
||||
Map.notMember name info ||
|
||||
Map.null maybeTypeMap ||
|
||||
(Map.member name usedTypedModules && isUsed name)
|
||||
where maybeTypeMap = info Map.! name
|
||||
isNewModule
|
||||
|| isntTyped
|
||||
|| isUsedAsUntyped
|
||||
|| isUsedAsTyped && isInstantiatedViaNonTyped
|
||||
|| allTypesHaveDefaults && notInstantiated
|
||||
where
|
||||
maybeTypeMap = Map.lookup name modules
|
||||
Just typeMap = maybeTypeMap
|
||||
isNewModule = maybeTypeMap == Nothing
|
||||
isntTyped = Map.null typeMap
|
||||
isUsedAsTyped = Map.member name usedTypedModules
|
||||
isUsedAsUntyped = Map.member name usedUntypedModules
|
||||
isInstantiatedViaNonTyped = untypedUsageSearch $ Set.singleton name
|
||||
allTypesHaveDefaults = all (/= UnknownType) (Map.elems typeMap)
|
||||
notInstantiated = lookup name instances == Nothing
|
||||
keepDescription _ = True
|
||||
|
||||
isUsed :: Identifier -> Bool
|
||||
isUsed name =
|
||||
any (flip Map.notMember usedTypedModules) used
|
||||
-- instantiate the type parameters if this is a used default instance
|
||||
reduceTypeDefaults :: Description -> Description
|
||||
reduceTypeDefaults (part @ (Part _ _ _ _ name _ _)) =
|
||||
if shouldntReduce
|
||||
then part
|
||||
else traverseModuleItems (traverseDecls rewriteDecl) part
|
||||
where
|
||||
used = usageSet $ expandSet name
|
||||
shouldntReduce =
|
||||
Map.notMember name modules || Map.null typeMap ||
|
||||
isTemplateTagged name
|
||||
typeMap = modules Map.! name
|
||||
rewriteDecl :: Decl -> Decl
|
||||
rewriteDecl (ParamType Parameter x t) =
|
||||
ParamType Localparam x t
|
||||
rewriteDecl other = other
|
||||
reduceTypeDefaults other = other
|
||||
|
||||
-- modules can be recursive; this checks if a typed module is not
|
||||
-- connected to any modules which are themselves used as typed modules
|
||||
untypedUsageSearch :: IdentSet -> Bool
|
||||
untypedUsageSearch visited =
|
||||
any (flip Map.notMember usedTypedModules) visited
|
||||
|| Set.size visited /= Set.size visited'
|
||||
&& untypedUsageSearch visited'
|
||||
where
|
||||
visited' =
|
||||
Set.union visited $
|
||||
Set.unions $
|
||||
Set.map expandSet visited
|
||||
expandSet :: Identifier -> IdentSet
|
||||
expandSet ident =
|
||||
case ( Map.lookup ident usedTypedModules
|
||||
, Map.lookup name usageMap) of
|
||||
(Just x, _) -> x
|
||||
(Nothing, Just x) -> x
|
||||
_ -> Set.empty
|
||||
usageSet :: IdentSet -> IdentSet
|
||||
usageSet names =
|
||||
if names' == names
|
||||
then names
|
||||
else usageSet names'
|
||||
where names' =
|
||||
Set.union names $
|
||||
Set.unions $
|
||||
Set.map expandSet names
|
||||
Map.findWithDefault Set.empty ident usedTypedModules
|
||||
|
||||
-- substitute in a particular instance's parameter types
|
||||
rewriteModule :: Description -> Instance -> Description
|
||||
rewriteModule part typeMap =
|
||||
rewriteModule part inst =
|
||||
Part attrs extern kw ml m' p (additionalParamItems ++ items')
|
||||
where
|
||||
Part attrs extern kw ml m p items = part
|
||||
m' = moduleInstanceName m typeMap
|
||||
m' = moduleInstanceName m inst
|
||||
items' = map rewriteModuleItem items
|
||||
rewriteModuleItem = traverseNestedModuleItems $ traverseNodes
|
||||
rewriteExpr rewriteDecl rewriteType rewriteLHS rewriteStmt
|
||||
rewriteDecl :: Decl -> Decl
|
||||
rewriteDecl (ParamType Parameter x t) =
|
||||
ParamType Localparam x $ rewriteType $
|
||||
case Map.lookup x typeMap of
|
||||
ParamType kind x $ rewriteType $
|
||||
case Map.lookup x inst of
|
||||
Nothing -> t
|
||||
Just (t', _) -> t'
|
||||
where kind = if Map.null inst
|
||||
then Parameter
|
||||
else Localparam
|
||||
rewriteDecl other =
|
||||
traverseDeclTypes rewriteType $
|
||||
traverseDeclExprs rewriteExpr other
|
||||
additionalParamItems = concatMap makeAddedParams $
|
||||
Map.toList $ Map.map snd typeMap
|
||||
Map.toList $ Map.map snd inst
|
||||
rewriteExpr :: Expr -> Expr
|
||||
rewriteExpr (orig @ (Dot (Ident x) y)) =
|
||||
if x == m
|
||||
|
|
@ -171,23 +189,32 @@ convert files =
|
|||
where name = addedParamTypeName paramName ident
|
||||
|
||||
-- write down module parameter names and type parameters
|
||||
collectDescriptionM :: Description -> Writer Info ()
|
||||
collectDescriptionM :: Description -> Writer Modules ()
|
||||
collectDescriptionM (part @ (Part _ _ _ _ name _ _)) =
|
||||
tell $ Map.singleton name maybeTypeMap
|
||||
tell $ Map.singleton name typeMap
|
||||
where
|
||||
maybeTypeMap = Map.fromList $ execWriter $
|
||||
typeMap = Map.fromList $ execWriter $
|
||||
collectModuleItemsM (collectDeclsM collectDeclM) part
|
||||
collectDeclM :: Decl -> Writer [(Identifier, Maybe Type)] ()
|
||||
collectDeclM (ParamType Parameter x v) =
|
||||
if v == UnknownType
|
||||
then tell [(x, Nothing)]
|
||||
else tell [(x, Just v)]
|
||||
collectDeclM :: Decl -> Writer [(Identifier, Type)] ()
|
||||
collectDeclM (ParamType Parameter x v) = tell [(x, v)]
|
||||
collectDeclM _ = return ()
|
||||
collectDescriptionM _ = return ()
|
||||
|
||||
-- generate a "unique" name for a particular module type instance
|
||||
moduleInstanceName :: Identifier -> Instance -> Identifier
|
||||
moduleInstanceName m inst = m ++ "_" ++ shortHash (m, inst)
|
||||
moduleInstanceName (TemplateTag m) inst =
|
||||
moduleInstanceName m inst
|
||||
moduleInstanceName m inst =
|
||||
if Map.null inst
|
||||
then TemplateTag m
|
||||
else m ++ "_" ++ shortHash (m, inst)
|
||||
|
||||
-- used to tag modules created for delayed type parameter instantiation
|
||||
pattern TemplateTag :: Identifier -> Identifier
|
||||
pattern TemplateTag x = '~' : x
|
||||
isTemplateTagged :: Identifier -> Bool
|
||||
isTemplateTagged TemplateTag{} = True
|
||||
isTemplateTagged _ = False
|
||||
|
||||
-- checks where a type is sufficiently resolved to be substituted
|
||||
isSimpleType :: Type -> Bool
|
||||
|
|
@ -199,8 +226,8 @@ isSimpleType typ =
|
|||
NonInteger {} -> True
|
||||
Net {} -> True
|
||||
Implicit {} -> True
|
||||
Struct _ fields _ -> all (isSimpleType . fst) fields
|
||||
Union _ fields _ -> all (isSimpleType . fst) fields
|
||||
Struct _ fields _ -> all (isSimpleType . fst) fields
|
||||
Union _ fields _ -> all (isSimpleType . fst) fields
|
||||
_ -> False
|
||||
|
||||
-- returns whether a top-level type contains any dimension queries or
|
||||
|
|
@ -239,21 +266,39 @@ addedParamName paramName var = paramName ++ '_' : var
|
|||
addedParamTypeName :: Identifier -> Identifier -> Identifier
|
||||
addedParamTypeName paramName var = paramName ++ '_' : var ++ "_type"
|
||||
|
||||
convertDescriptionM :: Description -> Writer Instances Description
|
||||
convertDescriptionM (Part attrs extern kw liftetime name ports items) =
|
||||
mapM convertModuleItemM items >>=
|
||||
return . Part attrs extern kw liftetime name ports
|
||||
convertDescriptionM other = return other
|
||||
|
||||
convertGenItemM :: GenItem -> Writer Instances GenItem
|
||||
convertGenItemM (GenModuleItem item) =
|
||||
convertModuleItemM item >>= return . GenModuleItem
|
||||
convertGenItemM other =
|
||||
traverseSinglyNestedGenItemsM convertGenItemM other
|
||||
|
||||
-- attempt to rewrite instantiations with type parameters
|
||||
convertModuleItemM :: Info -> ModuleItem -> Writer Instances ModuleItem
|
||||
convertModuleItemM info (orig @ (Instance m bindings x r p)) =
|
||||
if Map.notMember m info || Map.null maybeTypeMap then
|
||||
convertModuleItemM :: ModuleItem -> Writer Instances ModuleItem
|
||||
convertModuleItemM (orig @ (Instance m bindings x r p)) =
|
||||
if hasOnlyExprs then
|
||||
return orig
|
||||
else if any (not . isSimpleType . fst) resolvedTypes then
|
||||
return orig
|
||||
else do
|
||||
else if not hasUnresolvedTypes then do
|
||||
tell $ Set.singleton (m, resolvedTypes)
|
||||
let m' = moduleInstanceName m resolvedTypes
|
||||
return $ Generate $ map GenModuleItem $
|
||||
map (MIPackageItem . Decl) addedDecls ++
|
||||
[Instance m' (additionalBindings ++ exprBindings) x r p]
|
||||
else if isTemplateTagged m then
|
||||
return orig
|
||||
else do
|
||||
let m' = TemplateTag m
|
||||
tell $ Set.singleton (m, Map.empty)
|
||||
return $ Instance m' bindings x r p
|
||||
where
|
||||
maybeTypeMap = info Map.! m
|
||||
hasOnlyExprs = all (isRight . snd) bindings
|
||||
hasUnresolvedTypes = any (not . isSimpleType) (lefts $ map snd bindings)
|
||||
|
||||
-- determine the types corresponding to each type parameter
|
||||
bindingsMap = Map.fromList bindings
|
||||
resolvedTypesWithDecls = Map.mapMaybeWithKey resolveType bindingsMap
|
||||
|
|
@ -283,4 +328,8 @@ convertModuleItemM info (orig @ (Instance m bindings x r p)) =
|
|||
toTypeParam ident =
|
||||
(addedParamTypeName paramName ident, Left $ TypeOf $ Ident ident)
|
||||
|
||||
convertModuleItemM _ other = return other
|
||||
convertModuleItemM (Generate items) =
|
||||
mapM convertGenItemM items >>= return . Generate
|
||||
convertModuleItemM (MIAttr attr item) =
|
||||
convertModuleItemM item >>= return . MIAttr attr
|
||||
convertModuleItemM other = return other
|
||||
|
|
|
|||
|
|
@ -15,7 +15,8 @@ module mod #(
|
|||
endmodule
|
||||
|
||||
module top;
|
||||
typedef struct packed { byte y; } W;
|
||||
parameter type BASE = byte;
|
||||
typedef struct packed { BASE y; } W;
|
||||
W w;
|
||||
typedef struct packed { type(w) x, y; } V;
|
||||
V v;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,10 @@
|
|||
module mod #(
|
||||
parameter type T = logic
|
||||
);
|
||||
initial $display("$bits(T) = %0d", $bits(T));
|
||||
endmodule
|
||||
|
||||
module top;
|
||||
parameter SIZE = 8;
|
||||
mod #(logic [SIZE-1:0]) m();
|
||||
endmodule
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
module mod #(
|
||||
parameter S = 1
|
||||
);
|
||||
initial $display("$bits(T) = %0d", S);
|
||||
endmodule
|
||||
|
||||
module top;
|
||||
parameter SIZE = 8;
|
||||
mod #(SIZE) m();
|
||||
endmodule
|
||||
|
|
@ -28,4 +28,4 @@ module top_2; bar #(byte, 3) x(); endmodule
|
|||
module top_3; foo #(bit, 4) x(); endmodule
|
||||
module top_4; bar #(bit, 5) x(); endmodule
|
||||
|
||||
module top; endmodule
|
||||
module top; foo x(); endmodule
|
||||
|
|
|
|||
|
|
@ -48,4 +48,4 @@ module top_2; bar_byte #(3) x(); endmodule
|
|||
module top_3; foo_bit #(4) x(); endmodule
|
||||
module top_4; bar_bit #(5) x(); endmodule
|
||||
|
||||
module top; endmodule
|
||||
module top; foo_bit #(0) x(); endmodule
|
||||
|
|
|
|||
Loading…
Reference in New Issue