Commit 49c0d297 by Zachary Snow

fix package conversion not prefixing declarations with assignments (resolves #115)

parent 81890561
......@@ -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
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) =
Variable _ _ x _ _ -> insertElem x ()
Param _ _ x _ -> insertElem x ()
ParamType _ x _ -> insertElem x ()
CommentDecl{} -> return ()
traverseDeclTypesM traverseTypeM decl >>=
traverseDeclExprsM traverseExprM
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
convertModuleItemM =
traverseTypesM (traverseNestedTypesM convertTypeM) >=>
traverseExprsM (traverseNestedExprsM convertExprM) >=>
traverseLHSsM (traverseNestedLHSsM convertLHSM )
convertStmtM =
traverseStmtExprsM (traverseNestedExprsM convertExprM) >=>
traverseStmtLHSsM (traverseNestedLHSsM convertLHSM )
MIPackageItem item'' =
evalState
(traverseScopesM
traverseDeclM
convertModuleItemM
convertStmtM
(MIPackageItem item')) Set.empty
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
traverseExprM (Ident x) = prefixM x >>= return . Ident
traverseExprM other = traverseSinglyNestedExprsM traverseExprM other
traverseLHSM (LHSIdent x) = prefixM x >>= return . LHSIdent
traverseLHSM other = traverseSinglyNestedLHSsM traverseLHSM other
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
......
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
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
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