diff --git a/Convert/AlwaysKW.hs b/Convert/AlwaysKW.hs index bb16eab..8ad2a58 100644 --- a/Convert/AlwaysKW.hs +++ b/Convert/AlwaysKW.hs @@ -6,20 +6,19 @@ module Convert.AlwaysKW (convert) where -import Convert.Template.ModuleItem (moduleItemConverter) - +import Convert.Traverse import Language.SystemVerilog.AST convert :: AST -> AST -convert = moduleItemConverter convertModuleItem +convert = traverseDescriptions $ traverseModuleItems replaceAlwaysKW -- Conversions: -- `always_comb` -> `always @*` -- `always_ff` -> `always` -convertModuleItem :: ModuleItem -> ModuleItem -convertModuleItem (AlwaysC AlwaysComb stmt) = +replaceAlwaysKW :: ModuleItem -> ModuleItem +replaceAlwaysKW (AlwaysC AlwaysComb stmt) = AlwaysC Always $ Timing SenseStar stmt -convertModuleItem (AlwaysC AlwaysFF stmt) = +replaceAlwaysKW (AlwaysC AlwaysFF stmt) = AlwaysC Always stmt -convertModuleItem other = other +replaceAlwaysKW other = other diff --git a/Convert/CaseKW.hs b/Convert/CaseKW.hs index 888b9a5..09ebca4 100644 --- a/Convert/CaseKW.hs +++ b/Convert/CaseKW.hs @@ -11,17 +11,15 @@ module Convert.CaseKW (convert) where -import Convert.Template.Stmt (stmtConverter) - +import Convert.Traverse import Language.SystemVerilog.AST convert :: AST -> AST -convert = stmtConverter convertStmt +convert = traverseDescriptions (traverseModuleItems (traverseStmts convertStmt)) -- Conversions: -- `casez` -> `case` with wildcards (?, z) expanded -- `casex` -> `case` with wildcards (?, z, x) expanded - -- to be either 0 or 1 wildcards :: CaseKW -> [Char] diff --git a/Convert/StarPort.hs b/Convert/StarPort.hs index 29afc79..8171c8c 100644 --- a/Convert/StarPort.hs +++ b/Convert/StarPort.hs @@ -6,32 +6,27 @@ module Convert.StarPort (convert) where -import Data.Maybe +import Data.Maybe (mapMaybe) import qualified Data.Map.Strict as Map +import Convert.Traverse import Language.SystemVerilog.AST -type ModulePorts = Map.Map String [String] - convert :: AST -> AST -convert descriptions = map (convertDescription portsInfo) descriptions +convert descriptions = + traverseDescriptions (traverseModuleItems mapInstance) descriptions where - portsInfo = Map.fromList $ mapMaybe getPorts descriptions + modulePorts = Map.fromList $ mapMaybe getPorts descriptions getPorts :: Description -> Maybe (Identifier, [Identifier]) getPorts (Module name ports _) = Just (name, ports) getPorts _ = Nothing -convertDescription :: ModulePorts -> Description -> Description -convertDescription info (Module name ports items) = - Module name ports $ map (convertModuleItem info) items -convertDescription _ other = other - -convertModuleItem :: ModulePorts -> ModuleItem -> ModuleItem -convertModuleItem info (Instance m p x Nothing) = - Instance m p x (Just portBindings) - where - ports = case Map.lookup m info of - Nothing -> error $ "could not convert `.*` in instantiation of " ++ m - Just l -> l - portBindings = map (\port -> (port, Just $ Ident port)) ports -convertModuleItem _ other = other + mapInstance :: ModuleItem -> ModuleItem + mapInstance (Instance m p x Nothing) = + Instance m p x (Just portBindings) + where + ports = case Map.lookup m modulePorts of + Nothing -> error $ "could not convert `.*` in instantiation of " ++ m + Just l -> l + portBindings = map (\port -> (port, Just $ Ident port)) ports + mapInstance other = other diff --git a/Convert/Template/ModuleItem.hs b/Convert/Template/ModuleItem.hs deleted file mode 100644 index 857c7d4..0000000 --- a/Convert/Template/ModuleItem.hs +++ /dev/null @@ -1,45 +0,0 @@ -{- sv2v - - Author: Zachary Snow - - - - Template converter for ModuleItem transformations - - - - Also has coverage for ModuleItems inside of generate blocks - -} - -module Convert.Template.ModuleItem (moduleItemConverter) where - -import Data.Maybe -import Language.SystemVerilog.AST - -type Converter = ModuleItem -> ModuleItem - -moduleItemConverter :: Converter -> (AST -> AST) -moduleItemConverter f = convert f - -convert :: Converter -> AST -> AST -convert f modules = map (convertDescription f) modules - -convertDescription :: Converter -> Description -> Description -convertDescription f (Module name ports items) = - Module name ports $ map (convertModuleItem f) items -convertDescription _ (Typedef a b) = Typedef a b - -convertModuleItem :: Converter -> ModuleItem -> ModuleItem -convertModuleItem f (Generate items) = f $ Generate $ map (convertGenItem f) items -convertModuleItem f other = f other - -convertGenItem :: Converter -> GenItem -> GenItem -convertGenItem f item = convertGenItem' item - where - convertGenItem' :: GenItem -> GenItem - convertGenItem' (GenBlock x items) = GenBlock x $ map convertGenItem' items - convertGenItem' (GenFor a b c d items) = GenFor a b c d $ map convertGenItem' items - convertGenItem' (GenIf e i1 i2) = GenIf e (convertGenItem' i1) (convertGenItem' i2) - convertGenItem' (GenNull) = GenNull - convertGenItem' (GenModuleItem moduleItem) = GenModuleItem $ f moduleItem - convertGenItem' (GenCase e cases def) = GenCase e cases' def' - where - cases' = zip (map fst cases) (map (convertGenItem' . snd) cases) - def' = if def == Nothing - then Nothing - else Just $ convertGenItem' $ fromJust def diff --git a/Convert/Template/Stmt.hs b/Convert/Template/Stmt.hs deleted file mode 100644 index 0a3ca83..0000000 --- a/Convert/Template/Stmt.hs +++ /dev/null @@ -1,41 +0,0 @@ -{- sv2v - - Author: Zachary Snow - - - - Template converter for Stmt transformations - -} - -module Convert.Template.Stmt (stmtConverter) where - -import Convert.Template.ModuleItem (moduleItemConverter) -import Language.SystemVerilog.AST - -type Converter = Stmt -> Stmt - -stmtConverter :: Converter -> (AST -> AST) -stmtConverter = moduleItemConverter . convertModuleItem - -convertModuleItem :: Converter -> ModuleItem -> ModuleItem -convertModuleItem f (AlwaysC kw stmt) = - AlwaysC kw (convertStmt f stmt) -convertModuleItem f (Function ret name decls stmt) = - Function ret name decls (convertStmt f stmt) -convertModuleItem _ other = other - -convertStmt :: Converter -> (Stmt -> Stmt) -convertStmt f = f . convertStmt' - where - cs :: Stmt -> Stmt - cs = convertStmt f - convertStmt' :: Stmt -> Stmt - convertStmt' (Block decls stmts) = Block decls (map cs stmts) - convertStmt' (Case kw expr cases def) = - Case kw expr cases' def' - where - cases' = map (\(exprs, stmt) -> (exprs, cs stmt)) cases - def' = maybe Nothing (Just . cs) def - convertStmt' (AsgnBlk lhs expr) = AsgnBlk lhs expr - convertStmt' (Asgn lhs expr) = Asgn lhs expr - convertStmt' (For a b c stmt) = For a b c (cs stmt) - convertStmt' (If e s1 s2) = If e (cs s1) (cs s2) - convertStmt' (Timing sense stmt) = Timing sense (cs stmt) - convertStmt' (Null) = Null diff --git a/Convert/Traverse.hs b/Convert/Traverse.hs new file mode 100644 index 0000000..379cdfa --- /dev/null +++ b/Convert/Traverse.hs @@ -0,0 +1,96 @@ +{- sv2v + - Author: Zachary Snow + - + - Utilities for traversing AST transformations. + -} + +module Convert.Traverse +( MapperM +, Mapper +, unmonad +, traverseDescriptionsM +, traverseDescriptions +, traverseModuleItemsM +, traverseModuleItems +, traverseStmtsM +, traverseStmts +) where + +import Control.Monad.State +import Data.Maybe +import Language.SystemVerilog.AST + +type MapperM s t = t -> (State s) t +type Mapper t = t -> t + +unmonad :: (MapperM () a -> MapperM () b) -> Mapper a -> Mapper b +unmonad traverser mapper thing = + evalState (traverser (return . mapper) thing) () + +traverseDescriptionsM :: MapperM s Description -> MapperM s AST +traverseDescriptionsM mapper descriptions = + mapM mapper descriptions + +traverseDescriptions :: Mapper Description -> Mapper AST +traverseDescriptions = unmonad traverseDescriptionsM + +traverseModuleItemsM :: MapperM s ModuleItem -> MapperM s Description +traverseModuleItemsM mapper (Module name ports items) = + mapM fullMapper items >>= return . Module name ports + where + fullMapper (Generate genItems) = + mapM genItemMapper genItems >>= mapper . Generate + fullMapper other = mapper other + -- maps all ModuleItems within the given GenItem + genItemMapper (GenBlock x subItems) = + mapM genItemMapper subItems >>= return . GenBlock x + genItemMapper (GenFor a b c d subItems) = + mapM genItemMapper subItems >>= return . GenFor a b c d + genItemMapper (GenIf e i1 i2) = do + i1' <- genItemMapper i1 + i2' <- genItemMapper i2 + return $ GenIf e i1' i2' + genItemMapper (GenNull) = return GenNull + genItemMapper (GenModuleItem moduleItem) = + fullMapper moduleItem >>= return . GenModuleItem + genItemMapper (GenCase e cases def) = do + caseItems <- mapM (genItemMapper . snd) cases + let cases' = zip (map fst cases) caseItems + def' <- if def == Nothing + then return Nothing + else genItemMapper (fromJust def) >>= \x -> return $ Just x + return $ GenCase e cases' def' +traverseModuleItemsM _ orig = return orig + +traverseModuleItems :: Mapper ModuleItem -> Mapper Description +traverseModuleItems = unmonad traverseModuleItemsM + +traverseStmtsM :: MapperM s Stmt -> MapperM s ModuleItem +traverseStmtsM mapper = moduleItemMapper + where + moduleItemMapper (AlwaysC kw stmt) = + fullMapper stmt >>= return . AlwaysC kw + moduleItemMapper (Function ret name decls stmt) = + fullMapper stmt >>= return . Function ret name decls + moduleItemMapper other = return $ other + fullMapper stmt = mapper stmt >>= cs + cs (Block decls stmts) = mapM fullMapper stmts >>= return . Block decls + cs (Case kw expr cases def) = do + caseStmts <- mapM fullMapper $ map snd cases + let cases' = zip (map fst cases) caseStmts + def' <- if def == Nothing + then return Nothing + else fullMapper (fromJust def) >>= \x -> return $ Just x + return $ Case kw expr cases' def' + cs (AsgnBlk lhs expr) = return $ AsgnBlk lhs expr + cs (Asgn lhs expr) = return $ Asgn lhs expr + cs (For a b c stmt) = fullMapper stmt >>= return . For a b c + cs (If e s1 s2) = do + s1' <- fullMapper s1 + s2' <- fullMapper s2 + return $ If e s1' s2' + cs (Timing sense stmt) = fullMapper stmt >>= return . Timing sense + cs (Null) = return Null + +traverseStmts :: Mapper Stmt -> Mapper ModuleItem +traverseStmts = unmonad traverseStmtsM diff --git a/sv2v.cabal b/sv2v.cabal index c8f810c..c54e205 100644 --- a/sv2v.cabal +++ b/sv2v.cabal @@ -50,7 +50,8 @@ executable sv2v build-depends: array, base, - containers + containers, + mtl other-modules: Language.SystemVerilog Language.SystemVerilog.AST @@ -66,8 +67,7 @@ executable sv2v Convert.PackedArrayFlatten Convert.StarPort Convert.Typedef - Convert.Template.ModuleItem - Convert.Template.Stmt + Convert.Traverse ghc-options: -O3 -threaded