mirror of https://github.com/zachjs/sv2v.git
functional parameter type conversion
This commit is contained in:
Zachary Snow
parent
4de585ec0f
commit
6271e16b68
|
|
@ -10,6 +10,7 @@ import Control.Monad.Writer
|
|||
import Data.Either (isLeft)
|
||||
import Data.Maybe (isJust, isNothing, fromJust)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Convert.Traverse
|
||||
import Language.SystemVerilog.AST
|
||||
|
|
@ -20,14 +21,17 @@ type Info = Map.Map Identifier ([Identifier], MaybeTypeMap)
|
|||
type Instance = Map.Map Identifier Type
|
||||
type Instances = [(Identifier, Instance)]
|
||||
|
||||
type IdentSet = Set.Set Identifier
|
||||
type UsageMap = [(Identifier, Set.Set Identifier)]
|
||||
|
||||
convert :: [AST] -> [AST]
|
||||
convert files =
|
||||
concatMap (map explodeDescription) files'
|
||||
files'''
|
||||
where
|
||||
info = execWriter $
|
||||
mapM (collectDescriptionsM collectDescriptionM) files
|
||||
(files', instancesRaw) = runWriter $ mapM
|
||||
(mapM $ traverseModuleItemsM $ mapInstance info) files
|
||||
(mapM $ traverseModuleItemsM $ convertModuleItemM info) files
|
||||
instances = reverse $ uniq [] instancesRaw
|
||||
-- TODO: use the unique package
|
||||
uniq curr [] = curr
|
||||
|
|
@ -36,24 +40,113 @@ convert files =
|
|||
then uniq curr xs
|
||||
else uniq (x : curr) xs
|
||||
|
||||
-- add type parameter instantiations
|
||||
files'' = map (concatMap explodeDescription) files'
|
||||
explodeDescription :: Description -> [Description]
|
||||
explodeDescription (part @ (Part _ _ _ name _ _)) =
|
||||
if null theseInstances
|
||||
then [part]
|
||||
else map (rewriteModule part) theseInstances
|
||||
where theseInstances = map snd $ filter ((== name) . fst) instances
|
||||
if null theseInstances then
|
||||
[part]
|
||||
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
|
||||
moduleName _ = error "not possible"
|
||||
explodeDescription other = [other]
|
||||
|
||||
-- TODO FIXME: Need to keep around the default instance and not perform
|
||||
-- substitutions in it.
|
||||
-- remove or rewrite source modules that are no longer needed
|
||||
files''' = map (reverse . uniq [] . concatMap replaceDefault) 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 ()
|
||||
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 _ = return ()
|
||||
replaceDefault :: Description -> [Description]
|
||||
replaceDefault (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
|
||||
(:) (removeDefaultTypeParams part) $
|
||||
if isNothing typeMap
|
||||
then []
|
||||
else [rewriteModule part $ fromJust typeMap]
|
||||
where
|
||||
maybeTypeMap = snd $ info Map.! name
|
||||
typeMap = defaultInstance maybeTypeMap
|
||||
replaceDefault other = [other]
|
||||
|
||||
-- substitute in a particular instance's paramter types
|
||||
removeDefaultTypeParams :: Description -> Description
|
||||
removeDefaultTypeParams (part @ (Part _ _ _ _ _ _)) =
|
||||
Part extern kw ml (moduleDefaultName name) p items
|
||||
where
|
||||
Part extern kw ml name p items =
|
||||
traverseModuleItems (traverseDecls rewriteDecl) part
|
||||
rewriteDecl :: Decl -> Decl
|
||||
rewriteDecl (ParamType Parameter x _) =
|
||||
ParamType Parameter x Nothing
|
||||
rewriteDecl other = other
|
||||
removeDefaultTypeParams _ = error "not possible"
|
||||
|
||||
isUsed :: Identifier -> Bool
|
||||
isUsed name =
|
||||
any (flip Map.notMember usedTypedModules) used
|
||||
where
|
||||
used = usageSet $ expandSet name
|
||||
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
|
||||
|
||||
-- substitute in a particular instance's parameter types
|
||||
rewriteModule :: Description -> Instance -> Description
|
||||
rewriteModule part typeMap =
|
||||
Part extern kw ml m' p items'
|
||||
where
|
||||
Part extern kw ml m p items = part
|
||||
m' = renameModule info m typeMap
|
||||
m' = moduleInstanceName m typeMap
|
||||
items' = map rewriteDecl items
|
||||
rewriteDecl :: ModuleItem -> ModuleItem
|
||||
rewriteDecl (MIPackageItem (Decl (ParamType Parameter x _))) =
|
||||
|
|
@ -67,7 +160,6 @@ convert files =
|
|||
----- ParamType Localparam x (Just $ typeMap Map.! x)
|
||||
-----rewriteDecl other = other
|
||||
|
||||
|
||||
-- write down module parameter names and type parameters
|
||||
collectDescriptionM :: Description -> Writer Info ()
|
||||
collectDescriptionM (part @ (Part _ _ _ name _ _)) =
|
||||
|
|
@ -93,24 +185,65 @@ defaultInstance maybeTypeMap =
|
|||
else Just $ Map.map fromJust maybeTypeMap
|
||||
|
||||
-- generate a "unique" name for a particular module type instance
|
||||
renameModule :: Info -> Identifier -> Instance -> Identifier
|
||||
renameModule info m inst =
|
||||
if defaultInstance maybeTypeMap == Just inst
|
||||
then m -- default instances keep the original module name
|
||||
else m ++ "_" ++ shortHash (m, inst)
|
||||
where maybeTypeMap = snd $ info Map.! m
|
||||
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"
|
||||
|
||||
mapInstance :: Info -> ModuleItem -> Writer Instances ModuleItem
|
||||
mapInstance info (orig @ (Instance m bindings x r p)) =
|
||||
-- attempt to convert an expression to syntactically equivalent type
|
||||
exprToType :: Expr -> Maybe Type
|
||||
exprToType (Ident x) = Just $ Alias Nothing x []
|
||||
exprToType (PSIdent x y) = Just $ Alias (Just x) y []
|
||||
exprToType (Range e NonIndexed r) =
|
||||
case exprToType e of
|
||||
Nothing -> Nothing
|
||||
Just t -> Just $ tf (rs ++ [r])
|
||||
where (tf, rs) = typeRanges t
|
||||
exprToType (Bit e i) =
|
||||
case exprToType e of
|
||||
Nothing -> Nothing
|
||||
Just t -> Just $ tf (rs ++ [r])
|
||||
where
|
||||
(tf, rs) = typeRanges t
|
||||
r = (simplify $ BinOp Sub i (Number "1"), Number "0")
|
||||
exprToType _ = Nothing
|
||||
|
||||
-- checks where a type is sufficiently resolved to be substituted
|
||||
-- TODO: If a type parameter contains an expression, that expression should be
|
||||
-- substituted into the new module, or created as a new parameter.
|
||||
isSimpleType :: Type -> Bool
|
||||
isSimpleType (IntegerVector _ _ _) = True
|
||||
isSimpleType (IntegerAtom _ _ ) = True
|
||||
isSimpleType (NonInteger _ ) = True
|
||||
isSimpleType (Net _ _ ) = True
|
||||
isSimpleType _ = False
|
||||
|
||||
-- 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 then
|
||||
return orig
|
||||
else if Map.null maybeTypeMap then
|
||||
return $ Instance m bindingsNamed 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) resolvedTypes then do
|
||||
let defaults = Map.map Left resolvedTypes
|
||||
let bindingsDefaulted = Map.toList $ Map.union bindingsMap defaults
|
||||
if isDefaultName m
|
||||
then return $ Instance m bindingsNamed x r p
|
||||
else return $ Instance (moduleDefaultName m) bindingsDefaulted x r p
|
||||
else do
|
||||
tell [(m, resolvedTypes)]
|
||||
let m' = renameModule info m resolvedTypes
|
||||
let m' = moduleInstanceName m resolvedTypes
|
||||
return $ Instance m' bindings' x r p
|
||||
where
|
||||
(paramNames, maybeTypeMap) = info Map.! m
|
||||
|
|
@ -134,12 +267,16 @@ mapInstance info (orig @ (Instance m bindings x r p)) =
|
|||
" is missing a type parameter: " ++ paramName
|
||||
(Just (Left t), _) -> t
|
||||
(Just (Right e), _) ->
|
||||
-- TODO: Some types could have been parsed as an expression
|
||||
-- (i.e. aliases). Ideally we should have any such aliases
|
||||
-- resolved before applying this conversion.
|
||||
error $ "instantiation " ++ show orig ++ " has expr "
|
||||
++ show e ++ " for type param: " ++ paramName
|
||||
-- Some types are parsed as expressions because of the
|
||||
-- ambiguities of defined type names.
|
||||
case exprToType e of
|
||||
Just t -> t
|
||||
Nothing ->
|
||||
error $ "instantiation " ++ show orig
|
||||
++ " has expr " ++ show e
|
||||
++ " for type param: " ++ paramName
|
||||
|
||||
-- leave only the normal expression params behind
|
||||
isParamType = flip Map.member maybeTypeMap
|
||||
bindings' = filter (not . isParamType . fst) bindingsNamed
|
||||
mapInstance _ other = return other
|
||||
convertModuleItemM _ other = return other
|
||||
|
|
|
|||
|
|
@ -849,6 +849,13 @@ traverseTypesM mapper item =
|
|||
fullMapper t >>= \t' -> return $ MIPackageItem $ Function l t' x d s
|
||||
miMapper (MIPackageItem (other @ (Task _ _ _ _))) =
|
||||
return $ MIPackageItem other
|
||||
miMapper (Instance m params x r p) = do
|
||||
params' <- mapM mapParam params
|
||||
return $ Instance m params' x r p
|
||||
where
|
||||
mapParam (i, Left t) =
|
||||
fullMapper t >>= \t' -> return (i, Left t')
|
||||
mapParam (i, Right e) = return $ (i, Right e)
|
||||
miMapper other = return other
|
||||
|
||||
traverseTypes :: Mapper Type -> Mapper ModuleItem
|
||||
|
|
|
|||
|
|
@ -36,6 +36,7 @@ convert =
|
|||
convertDescription :: Types -> Description -> Description
|
||||
convertDescription globalTypes description =
|
||||
traverseModuleItems removeTypedef $
|
||||
traverseModuleItems convertModuleItem $
|
||||
traverseModuleItems (traverseExprs $ traverseNestedExprs $ convertExpr) $
|
||||
traverseModuleItems (traverseTypes $ resolveType types) $
|
||||
description
|
||||
|
|
@ -49,12 +50,20 @@ convertDescription globalTypes description =
|
|||
removeTypedef (MIPackageItem (Typedef _ x)) =
|
||||
MIPackageItem $ Comment $ "removed typedef: " ++ x
|
||||
removeTypedef other = other
|
||||
convertExpr :: Expr -> Expr
|
||||
convertExpr (Bits (Right (Ident x))) =
|
||||
convertTypeOrExpr :: TypeOrExpr -> TypeOrExpr
|
||||
convertTypeOrExpr (Right (Ident x)) =
|
||||
if Map.member x types
|
||||
then Bits $ Left $ resolveType types (Alias Nothing x [])
|
||||
else Bits $ Right $ Ident x
|
||||
then Left $ resolveType types (Alias Nothing x [])
|
||||
else Right $ Ident x
|
||||
convertTypeOrExpr other = other
|
||||
convertExpr :: Expr -> Expr
|
||||
convertExpr (Bits v) = Bits $ convertTypeOrExpr v
|
||||
convertExpr other = other
|
||||
convertModuleItem :: ModuleItem -> ModuleItem
|
||||
convertModuleItem (Instance m params x r p) =
|
||||
Instance m (map mapParam params) x r p
|
||||
where mapParam (i, v) = (i, convertTypeOrExpr v)
|
||||
convertModuleItem other = other
|
||||
|
||||
resolveItem :: Types -> (Type, Identifier) -> (Type, Identifier)
|
||||
resolveItem types (t, x) = (resolveType types t, x)
|
||||
|
|
|
|||
|
|
@ -88,6 +88,7 @@ module d_1; n_def #(logic [1:0], logic [2:0]) x(); endmodule
|
|||
module d_2; n_def #(.T(logic [1:0])) x(); endmodule
|
||||
module d_3; n_def #(.U(logic [1:0])) x(); endmodule
|
||||
module d_4; n_def #(.U(logic), .T(logic [1:0])) x(); endmodule
|
||||
module d_5; n_def x(); endmodule
|
||||
|
||||
module e_1; n_tdef #(logic [1:0], logic [2:0]) x(); endmodule
|
||||
module e_2; n_tdef #(.T(logic [1:0]), .U(logic)) x(); endmodule
|
||||
|
|
|
|||
|
|
@ -20,6 +20,8 @@ module top;
|
|||
$display("n_def 01 00000000000000000000000000000010 2");
|
||||
$display("n_def 00 00000000000000000000000000000001 2");
|
||||
$display("n_def 1 00000000000000000000000000000010 1");
|
||||
$display("n_def 0 00000000000000000000000000000001 1");
|
||||
$display("n_def 1 00000000000000000000000000000010 1");
|
||||
$display("n_tdef 00 00000000000000000000000000000001 2");
|
||||
$display("n_tdef 001 00000000000000000000000000000010 3");
|
||||
$display("n_tdef 00 00000000000000000000000000000001 2");
|
||||
|
|
|
|||
|
|
@ -0,0 +1,31 @@
|
|||
module foo #(
|
||||
parameter type T = logic,
|
||||
parameter size = 0
|
||||
);
|
||||
generate
|
||||
if (size != 0) begin : foo
|
||||
bar #(T, size - 1) x();
|
||||
end
|
||||
endgenerate
|
||||
initial $display("foo %d %d", $bits(T), size);
|
||||
endmodule
|
||||
|
||||
module bar #(
|
||||
parameter type U = logic,
|
||||
parameter size = 0
|
||||
);
|
||||
generate
|
||||
if (size != 0) begin : bar
|
||||
foo #(U, size - 1) x();
|
||||
end
|
||||
endgenerate
|
||||
initial $display("bar %d %d", $bits(U), size);
|
||||
endmodule
|
||||
|
||||
module top_1; foo #(byte, 2) x(); endmodule
|
||||
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
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
module foo_default #(
|
||||
parameter size = 0
|
||||
);
|
||||
initial $display("foo %d %d", 1, size);
|
||||
endmodule
|
||||
|
||||
module bar_default #(
|
||||
parameter size = 0
|
||||
);
|
||||
initial $display("bar %d %d", 1, size);
|
||||
endmodule
|
||||
|
||||
module foo_byte #(
|
||||
parameter size = 0
|
||||
);
|
||||
generate
|
||||
if (size != 0) begin : foo
|
||||
bar_byte #(size - 1) x();
|
||||
end
|
||||
endgenerate
|
||||
initial $display("foo %d %d", 8, size);
|
||||
endmodule
|
||||
|
||||
module bar_byte #(
|
||||
parameter size = 0
|
||||
);
|
||||
generate
|
||||
if (size != 0) begin : bar
|
||||
foo_byte #(size - 1) x();
|
||||
end
|
||||
endgenerate
|
||||
initial $display("bar %d %d", 8, size);
|
||||
endmodule
|
||||
|
||||
module foo_bit #(
|
||||
parameter size = 0
|
||||
);
|
||||
generate
|
||||
if (size != 0) begin : foo
|
||||
bar_bit #(size - 1) x();
|
||||
end
|
||||
endgenerate
|
||||
initial $display("foo %d %d", 1, size);
|
||||
endmodule
|
||||
|
||||
module bar_bit #(
|
||||
parameter size = 0
|
||||
);
|
||||
generate
|
||||
if (size != 0) begin : bar
|
||||
foo_bit #(size - 1) x();
|
||||
end
|
||||
endgenerate
|
||||
initial $display("bar %d %d", 1, size);
|
||||
endmodule
|
||||
|
||||
module top_1; foo_byte #(2) x(); endmodule
|
||||
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
|
||||
Loading…
Reference in New Issue