mirror of https://github.com/zachjs/sv2v.git
fix package conversion not prefixing declarations with assignments (resolves #115)
This commit is contained in:
Zachary Snow
parent
81890561a3
commit
49c0d297c9
|
|
@ -30,6 +30,7 @@ import Control.Monad.Writer
|
|||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Convert.Scoper
|
||||
import Convert.Traverse
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
|
|
@ -65,7 +66,7 @@ convertFile packages ast =
|
|||
|
||||
globalPackageItems :: Identifier -> PackageItems -> [PackageItem]
|
||||
globalPackageItems name items =
|
||||
map (prefixPackageItem name (packageItemIdents items)) (map snd items)
|
||||
prefixPackageItems name (packageItemIdents items) (map snd items)
|
||||
|
||||
packageItemIdents :: PackageItems -> Idents
|
||||
packageItemIdents items =
|
||||
|
|
@ -78,66 +79,73 @@ packageItemIdents items =
|
|||
Set.fromList $ map fst enumItems
|
||||
packageItemSubIdents _ = Set.empty
|
||||
|
||||
prefixPackageItem :: Identifier -> Idents -> PackageItem -> PackageItem
|
||||
prefixPackageItem packageName idents item =
|
||||
item''
|
||||
prefixPackageItems :: Identifier -> Idents -> [PackageItem] -> [PackageItem]
|
||||
prefixPackageItems packageName idents items =
|
||||
map unwrap $ evalScoper
|
||||
traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
|
||||
packageName $ map (wrap . initialPrefix) items
|
||||
where
|
||||
wrap :: PackageItem -> ModuleItem
|
||||
wrap = MIPackageItem
|
||||
unwrap :: ModuleItem -> PackageItem
|
||||
unwrap (MIPackageItem item) = item
|
||||
unwrap _ = error "unwrap invariant violated"
|
||||
|
||||
initialPrefix :: PackageItem -> PackageItem
|
||||
initialPrefix item =
|
||||
case item of
|
||||
Function a b x c d -> Function a b (prefix x) c d
|
||||
Task a x c d -> Task a (prefix x) c d
|
||||
Typedef a x -> Typedef a (prefix x)
|
||||
Decl (Variable a b x c d) -> Decl (Variable a b (prefix x) c d)
|
||||
Decl (Param a b x c ) -> Decl (Param a b (prefix x) c )
|
||||
Decl (ParamType a x b ) -> Decl (ParamType a (prefix x) b )
|
||||
other -> other
|
||||
|
||||
prefix :: Identifier -> Identifier
|
||||
prefix x =
|
||||
if Set.member x idents
|
||||
then packageName ++ '_' : x
|
||||
else x
|
||||
prefixM :: Identifier -> State Idents Identifier
|
||||
prefixM :: Identifier -> Scoper () Identifier
|
||||
prefixM x = do
|
||||
locals <- get
|
||||
if Set.notMember x locals
|
||||
details <- lookupElemM x
|
||||
if details == Nothing
|
||||
then return $ prefix x
|
||||
else return x
|
||||
traverseDeclM :: Decl -> State Idents Decl
|
||||
|
||||
traverseDeclM :: Decl -> Scoper () Decl
|
||||
traverseDeclM decl = do
|
||||
case decl of
|
||||
Variable _ _ x _ _ -> modify $ Set.insert x
|
||||
Param _ _ x _ -> modify $ Set.insert x
|
||||
ParamType _ x _ -> modify $ Set.insert x
|
||||
_ -> return ()
|
||||
traverseDeclTypesM (traverseNestedTypesM convertTypeM) decl
|
||||
Variable _ _ x _ _ -> insertElem x ()
|
||||
Param _ _ x _ -> insertElem x ()
|
||||
ParamType _ x _ -> insertElem x ()
|
||||
CommentDecl{} -> return ()
|
||||
traverseDeclTypesM traverseTypeM decl >>=
|
||||
traverseDeclExprsM traverseExprM
|
||||
|
||||
item' = case item of
|
||||
Function a b x c d -> Function a b (prefix x) c d
|
||||
Task a x c d -> Task a (prefix x) c d
|
||||
Typedef a x -> Typedef a (prefix x)
|
||||
Decl (Variable a b x c d) -> Decl (Variable a b (prefix x) c d)
|
||||
Decl (Param a b x c ) -> Decl (Param a b (prefix x) c )
|
||||
Decl (ParamType a x b ) -> Decl (ParamType a (prefix x) b )
|
||||
other -> other
|
||||
|
||||
convertTypeM (Alias x rs) =
|
||||
traverseTypeM :: Type -> Scoper () Type
|
||||
traverseTypeM (Alias x rs) =
|
||||
prefixM x >>= \x' -> return $ Alias x' rs
|
||||
convertTypeM (Enum t items rs) =
|
||||
mapM prefixItem items >>= \items' -> return $ Enum t items' rs
|
||||
where prefixItem (x, e) = prefixM x >>= \x' -> return (x', e)
|
||||
convertTypeM other = return other
|
||||
convertExprM (Ident x) = prefixM x >>= return . Ident
|
||||
convertExprM other =
|
||||
traverseExprTypesM (traverseNestedTypesM convertTypeM) other
|
||||
convertLHSM (LHSIdent x) = prefixM x >>= return . LHSIdent
|
||||
convertLHSM other = return other
|
||||
traverseTypeM (Enum t enumItems rs) = do
|
||||
enumItems' <- mapM prefixEnumItem enumItems
|
||||
return $ Enum t enumItems' rs
|
||||
where prefixEnumItem (x, e) = prefixM x >>= \x' -> return (x', e)
|
||||
traverseTypeM other = traverseSinglyNestedTypesM traverseTypeM other
|
||||
|
||||
convertModuleItemM =
|
||||
traverseTypesM (traverseNestedTypesM convertTypeM) >=>
|
||||
traverseExprsM (traverseNestedExprsM convertExprM) >=>
|
||||
traverseLHSsM (traverseNestedLHSsM convertLHSM )
|
||||
convertStmtM =
|
||||
traverseStmtExprsM (traverseNestedExprsM convertExprM) >=>
|
||||
traverseStmtLHSsM (traverseNestedLHSsM convertLHSM )
|
||||
traverseExprM (Ident x) = prefixM x >>= return . Ident
|
||||
traverseExprM other = traverseSinglyNestedExprsM traverseExprM other
|
||||
traverseLHSM (LHSIdent x) = prefixM x >>= return . LHSIdent
|
||||
traverseLHSM other = traverseSinglyNestedLHSsM traverseLHSM other
|
||||
|
||||
MIPackageItem item'' =
|
||||
evalState
|
||||
(traverseScopesM
|
||||
traverseDeclM
|
||||
convertModuleItemM
|
||||
convertStmtM
|
||||
(MIPackageItem item')) Set.empty
|
||||
traverseGenItemM = error "not possible"
|
||||
traverseModuleItemM =
|
||||
traverseTypesM traverseTypeM >=>
|
||||
traverseExprsM traverseExprM >=>
|
||||
traverseLHSsM traverseLHSM
|
||||
traverseStmtM =
|
||||
traverseStmtExprsM traverseExprM >=>
|
||||
traverseStmtLHSsM traverseLHSM
|
||||
|
||||
collectDescriptionM :: Description -> Writer Packages ()
|
||||
collectDescriptionM (Package _ name items) =
|
||||
|
|
@ -191,8 +199,8 @@ traverseModuleItem existingItemNames packages (MIPackageItem (Import x y)) =
|
|||
namesToAvoid = case y of
|
||||
Nothing -> existingItemNames
|
||||
Just ident -> Set.delete ident existingItemNames
|
||||
itemsRenamed = map
|
||||
(prefixPackageItem x namesToAvoid)
|
||||
itemsRenamed =
|
||||
prefixPackageItems x namesToAvoid
|
||||
(map snd packageItems)
|
||||
traverseModuleItem _ _ item =
|
||||
(traverseExprs $ traverseNestedExprs traverseExpr) $
|
||||
|
|
|
|||
|
|
@ -35,6 +35,9 @@ module Convert.Traverse
|
|||
, traverseDeclsM
|
||||
, traverseDecls
|
||||
, collectDeclsM
|
||||
, traverseSinglyNestedTypesM
|
||||
, traverseSinglyNestedTypes
|
||||
, collectSinglyNestedTypesM
|
||||
, traverseNestedTypesM
|
||||
, traverseNestedTypes
|
||||
, collectNestedTypesM
|
||||
|
|
@ -84,6 +87,9 @@ module Convert.Traverse
|
|||
, traverseNestedLHSsM
|
||||
, traverseNestedLHSs
|
||||
, collectNestedLHSsM
|
||||
, traverseSinglyNestedLHSsM
|
||||
, traverseSinglyNestedLHSs
|
||||
, collectSinglyNestedLHSsM
|
||||
, traverseScopesM
|
||||
, traverseFilesM
|
||||
, traverseFiles
|
||||
|
|
@ -713,20 +719,28 @@ collectLHSsM = collectify traverseLHSsM
|
|||
|
||||
traverseNestedLHSsM :: Monad m => MapperM m LHS -> MapperM m LHS
|
||||
traverseNestedLHSsM mapper = fullMapper
|
||||
where
|
||||
fullMapper = mapper >=> tl
|
||||
tl (LHSIdent x ) = return $ LHSIdent x
|
||||
tl (LHSBit l e ) = fullMapper l >>= \l' -> return $ LHSBit l' e
|
||||
tl (LHSRange l m r ) = fullMapper l >>= \l' -> return $ LHSRange l' m r
|
||||
tl (LHSDot l x ) = fullMapper l >>= \l' -> return $ LHSDot l' x
|
||||
tl (LHSConcat lhss) = mapM fullMapper lhss >>= return . LHSConcat
|
||||
tl (LHSStream o e lhss) = mapM fullMapper lhss >>= return . LHSStream o e
|
||||
where fullMapper = mapper >=> traverseSinglyNestedLHSsM fullMapper
|
||||
|
||||
traverseNestedLHSs :: Mapper LHS -> Mapper LHS
|
||||
traverseNestedLHSs = unmonad traverseNestedLHSsM
|
||||
collectNestedLHSsM :: Monad m => CollectorM m LHS -> CollectorM m LHS
|
||||
collectNestedLHSsM = collectify traverseNestedLHSsM
|
||||
|
||||
traverseSinglyNestedLHSsM :: Monad m => MapperM m LHS -> MapperM m LHS
|
||||
traverseSinglyNestedLHSsM mapper = tl
|
||||
where
|
||||
tl (LHSIdent x ) = return $ LHSIdent x
|
||||
tl (LHSBit l e ) = mapper l >>= \l' -> return $ LHSBit l' e
|
||||
tl (LHSRange l m r ) = mapper l >>= \l' -> return $ LHSRange l' m r
|
||||
tl (LHSDot l x ) = mapper l >>= \l' -> return $ LHSDot l' x
|
||||
tl (LHSConcat lhss) = mapM mapper lhss >>= return . LHSConcat
|
||||
tl (LHSStream o e lhss) = mapM mapper lhss >>= return . LHSStream o e
|
||||
|
||||
traverseSinglyNestedLHSs :: Mapper LHS -> Mapper LHS
|
||||
traverseSinglyNestedLHSs = unmonad traverseSinglyNestedLHSsM
|
||||
collectSinglyNestedLHSsM :: Monad m => CollectorM m LHS -> CollectorM m LHS
|
||||
collectSinglyNestedLHSsM = collectify traverseSinglyNestedLHSsM
|
||||
|
||||
traverseDeclsM :: Monad m => MapperM m Decl -> MapperM m ModuleItem
|
||||
traverseDeclsM mapper item = do
|
||||
item' <- miMapper item
|
||||
|
|
@ -751,10 +765,9 @@ traverseDecls = unmonad traverseDeclsM
|
|||
collectDeclsM :: Monad m => CollectorM m Decl -> CollectorM m ModuleItem
|
||||
collectDeclsM = collectify traverseDeclsM
|
||||
|
||||
traverseNestedTypesM :: Monad m => MapperM m Type -> MapperM m Type
|
||||
traverseNestedTypesM mapper = fullMapper
|
||||
traverseSinglyNestedTypesM :: Monad m => MapperM m Type -> MapperM m Type
|
||||
traverseSinglyNestedTypesM mapper = tm
|
||||
where
|
||||
fullMapper = mapper >=> tm
|
||||
typeOrExprMapper (Left t) = mapper t >>= return . Left
|
||||
typeOrExprMapper (Right e) = return $ Right e
|
||||
tm (Alias xx rs) = return $ Alias xx rs
|
||||
|
|
@ -771,20 +784,29 @@ traverseNestedTypesM mapper = fullMapper
|
|||
tm (TypeOf expr ) = return $ TypeOf expr
|
||||
tm (InterfaceT x my r) = return $ InterfaceT x my r
|
||||
tm (Enum t vals r) = do
|
||||
t' <- fullMapper t
|
||||
t' <- mapper t
|
||||
return $ Enum t' vals r
|
||||
tm (Struct p fields r) = do
|
||||
types <- mapM fullMapper $ map fst fields
|
||||
types <- mapM mapper $ map fst fields
|
||||
let idents = map snd fields
|
||||
return $ Struct p (zip types idents) r
|
||||
tm (Union p fields r) = do
|
||||
types <- mapM fullMapper $ map fst fields
|
||||
types <- mapM mapper $ map fst fields
|
||||
let idents = map snd fields
|
||||
return $ Union p (zip types idents) r
|
||||
tm (UnpackedType t r) = do
|
||||
t' <- fullMapper t
|
||||
t' <- mapper t
|
||||
return $ UnpackedType t' r
|
||||
|
||||
traverseSinglyNestedTypes :: Mapper Type -> Mapper Type
|
||||
traverseSinglyNestedTypes = unmonad traverseSinglyNestedTypesM
|
||||
collectSinglyNestedTypesM :: Monad m => CollectorM m Type -> CollectorM m Type
|
||||
collectSinglyNestedTypesM = collectify traverseSinglyNestedTypesM
|
||||
|
||||
traverseNestedTypesM :: Monad m => MapperM m Type -> MapperM m Type
|
||||
traverseNestedTypesM mapper = fullMapper
|
||||
where fullMapper = mapper >=> traverseSinglyNestedTypesM fullMapper
|
||||
|
||||
traverseNestedTypes :: Mapper Type -> Mapper Type
|
||||
traverseNestedTypes = unmonad traverseNestedTypesM
|
||||
collectNestedTypesM :: Monad m => CollectorM m Type -> CollectorM m Type
|
||||
|
|
|
|||
|
|
@ -0,0 +1,15 @@
|
|||
package PKG;
|
||||
function automatic logic f;
|
||||
return 0;
|
||||
endfunction
|
||||
|
||||
function automatic logic g;
|
||||
automatic logic res = f();
|
||||
return res;
|
||||
endfunction
|
||||
endpackage
|
||||
|
||||
module top;
|
||||
localparam A = PKG::g();
|
||||
initial $display("%b", A);
|
||||
endmodule
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
module top;
|
||||
function automatic f;
|
||||
input unused;
|
||||
f = 0;
|
||||
endfunction
|
||||
|
||||
function automatic g;
|
||||
input unused;
|
||||
g = f(0);
|
||||
endfunction
|
||||
|
||||
localparam A = g(0);
|
||||
initial $display("%b", A);
|
||||
endmodule
|
||||
Loading…
Reference in New Issue