mirror of https://github.com/zachjs/sv2v.git
97 lines
3.3 KiB
Haskell
97 lines
3.3 KiB
Haskell
{- sv2v
|
|
- Author: Zachary Snow <zach@zachjs.com>
|
|
-
|
|
- Conversion for moving top-level package items into modules
|
|
-}
|
|
|
|
module Convert.NestPI (convert) where
|
|
|
|
import Control.Monad.State
|
|
import Control.Monad.Writer
|
|
import qualified Data.Map.Strict as Map
|
|
import qualified Data.Set as Set
|
|
|
|
import Convert.Traverse
|
|
import Language.SystemVerilog.AST
|
|
|
|
type PIs = Map.Map Identifier PackageItem
|
|
type Idents = Set.Set Identifier
|
|
|
|
convert :: [AST] -> [AST]
|
|
convert asts =
|
|
map (filter (not . isPI) . nest) asts
|
|
where
|
|
nest :: AST -> AST
|
|
nest curr =
|
|
if next == curr
|
|
then curr
|
|
else nest next
|
|
where
|
|
next = evalState (traverseM curr) Map.empty
|
|
traverseM = traverseDescriptionsM traverseDescriptionM
|
|
isPI :: Description -> Bool
|
|
isPI (PackageItem item) = piName item /= Nothing
|
|
isPI _ = False
|
|
|
|
-- collects and nests in tasks and functions missing from modules
|
|
traverseDescriptionM :: Description -> State PIs Description
|
|
traverseDescriptionM (PackageItem item) = do
|
|
() <- case piName item of
|
|
Nothing -> return ()
|
|
Just ident -> modify $ Map.insert ident item
|
|
return $ PackageItem item
|
|
traverseDescriptionM (orig @ (Part extern kw lifetime name ports items)) = do
|
|
tfs <- get
|
|
let newItems = map MIPackageItem $ Map.elems $
|
|
Map.restrictKeys tfs neededPIs
|
|
return $ Part extern kw lifetime name ports (items ++ newItems)
|
|
where
|
|
existingPIs = execWriter $ collectModuleItemsM collectPIsM orig
|
|
runner f = execWriter $ collectModuleItemsM f orig
|
|
usedPIs = Set.unions $ map runner $
|
|
[ collectStmtsM collectSubroutinesM
|
|
, collectTypesM collectTypenamesM
|
|
, collectExprsM $ collectNestedExprsM collectIdentsM
|
|
]
|
|
neededPIs = Set.difference usedPIs existingPIs
|
|
traverseDescriptionM other = return other
|
|
|
|
-- writes down the names of package items
|
|
collectPIsM :: ModuleItem -> Writer Idents ()
|
|
collectPIsM (MIPackageItem item) =
|
|
case piName item of
|
|
Nothing -> return ()
|
|
Just ident -> tell $ Set.singleton ident
|
|
collectPIsM _ = return ()
|
|
|
|
-- writes down the names of subroutine invocations
|
|
collectSubroutinesM :: Stmt -> Writer Idents ()
|
|
collectSubroutinesM (Subroutine f _) = tell $ Set.singleton f
|
|
collectSubroutinesM _ = return ()
|
|
|
|
-- writes down the names of function calls and identifiers
|
|
collectIdentsM :: Expr -> Writer Idents ()
|
|
collectIdentsM (Call x _) = tell $ Set.singleton x
|
|
collectIdentsM (Ident x ) = tell $ Set.singleton x
|
|
collectIdentsM _ = return ()
|
|
|
|
-- writes down aliased typenames
|
|
collectTypenamesM :: Type -> Writer Idents ()
|
|
collectTypenamesM (Alias x _) = tell $ Set.singleton x
|
|
collectTypenamesM (Enum (Just t) _ _) = collectTypenamesM t
|
|
collectTypenamesM (Struct _ fields _) = do
|
|
_ <- mapM collectTypenamesM $ map fst fields
|
|
return ()
|
|
collectTypenamesM _ = return ()
|
|
|
|
-- returns the "name" of a package item, if it has one
|
|
piName :: PackageItem -> Maybe Identifier
|
|
piName (Function _ _ ident _ _) = Just ident
|
|
piName (Task _ ident _ _) = Just ident
|
|
piName (Typedef _ ident ) = Just ident
|
|
piName (Decl (Variable _ _ ident _ _)) = Just ident
|
|
piName (Decl (Parameter _ ident _)) = Just ident
|
|
piName (Decl (Localparam _ ident _)) = Just ident
|
|
piName (Import _ _) = Nothing
|
|
piName (Comment _) = Nothing
|