Skip to content

S
sv2v
Commit a87ee7c1 by Zachary Snow
Options

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
parent 003d4dbc
Showing with 152 additions and 82 deletions
src/Convert/ParamType.hs
{-# 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 $
(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
......@@ -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
return orig
else if any (not . isSimpleType . fst) resolvedTypes then
convertModuleItemM :: ModuleItem -> Writer Instances ModuleItem
convertModuleItemM (orig @ (Instance m bindings x r p)) =
if hasOnlyExprs 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
test/basic/paramtype_delay.sv
......@@ -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;
......
test/basic/paramtype_expr.sv 0 → 100644
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
test/basic/paramtype_expr.v 0 → 100644
module mod #(
parameter S = 1
);
initial $display("$bits(T) = %0d", S);
endmodule
module top;
parameter SIZE = 8;
mod #(SIZE) m();
endmodule
test/basic/paramtype_recurse.sv
......@@ -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
test/basic/paramtype_recurse.v
......@@ -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
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