luke
/
sv2v
mirror of https://github.com/zachjs/sv2v.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

more fleshed out Traverse module

This commit is contained in:
Zachary Snow 2019-02-25 16:19:55 -05:00
parent 8f5620da8e
commit cda40a13d0
4 changed files with 75 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Convert/CaseKW.hs
View File

@ -6,7 +6,7 @@
- Note that this conversion does not completely replicate the behavior of
- `casex` and `casez` in cases where that case expression itself (rather than
- just the case item patterns) contains wildcard values. This is apparently
- rarely ever intentially done.
- rarely ever intentionally done.
-}
module Convert.CaseKW (convert) where
@ -33,16 +33,15 @@ possibilities = ['0', '1']
explodeBy :: [Char] -> String -> [String]
explodeBy _ "" = [""]
explodeBy wilds (x : xs) =
[(:)] <*> chars <*> prev
where
chars = if elem x wilds then possibilities else [x]
prev = explodeBy wilds xs
(map (:) chars) <*> (explodeBy wilds xs)
where chars = if elem x wilds then possibilities else [x]
expandExpr :: [Char] -> Expr -> [Expr]
expandExpr wilds (Number s) = map Number $ explodeBy wilds s
expandExpr [] other = [other]
-- TODO: Hopefully they only give us constant expressions...
expandExpr _ other = error $ "CaseKW conversione encountered case that was not a number, which is dubious..." ++ (show other)
-- TODO: We could be given a constant identifier...
expandExpr _ other = error $ "CaseKW conversion encountered case that was not a number, which is dubious..." ++ (show other)
-- Note that we don't have to convert the statements within the cases, as the
-- conversion template takes care of that for us.

69
Convert/Logic.hs
View File

@ -13,65 +13,34 @@
module Convert.Logic (convert) where
import Control.Monad.Writer
import qualified Data.Set as Set
import Convert.Traverse
import Language.SystemVerilog.AST
type RegIdents = Set.Set String
convert :: AST -> AST
convert descriptions = map convertDescription descriptions
convert = traverseDescriptions convertDescription
convertDescription :: Description -> Description
convertDescription (Module name ports items) =
Module name ports $ map (convertModuleItem idents) items
convertDescription orig =
traverseModuleItems convertModuleItem orig
where
idents = Set.unions $ map getRegIdents items
convertDescription other = other
idents = execWriter (collectModuleItemsM regIdents orig)
convertModuleItem :: ModuleItem -> ModuleItem
convertModuleItem (MIDecl (Variable dir (Logic mr) ident a me)) =
MIDecl $ Variable dir (t mr) ident a me
where t = if Set.member ident idents then Reg else Wire
convertModuleItem other = other
getStmtLHSs :: Stmt -> [LHS]
getStmtLHSs (Block _ stmts) = concat $ map getStmtLHSs stmts
getStmtLHSs (Case kw e cases (Just stmt)) = (getStmtLHSs stmt) ++ (getStmtLHSs $ Case kw e cases Nothing)
getStmtLHSs (Case _ _ cases Nothing) = concat $ map getStmtLHSs $ map snd cases
getStmtLHSs (AsgnBlk lhs _) = [lhs]
getStmtLHSs (Asgn lhs _) = [lhs]
getStmtLHSs (For _ _ _ stmt) = getStmtLHSs stmt
getStmtLHSs (If _ s1 s2) = (getStmtLHSs s1) ++ (getStmtLHSs s2)
getStmtLHSs (Timing _ s) = getStmtLHSs s
getStmtLHSs (Null) = []
getLHSIdents :: LHS -> [Identifier]
getLHSIdents (LHS vx ) = [vx]
getLHSIdents (LHSBit vx _) = [vx]
getLHSIdents (LHSRange vx _) = [vx]
getLHSIdents (LHSConcat lhss) = concat $ map getLHSIdents lhss
getRegIdents :: ModuleItem -> RegIdents
getRegIdents (AlwaysC _ stmt) =
Set.fromList idents
regIdents :: ModuleItem -> Writer RegIdents ()
regIdents (AlwaysC _ stmt) = collectStmtLHSsM idents stmt
where
lhss = getStmtLHSs stmt
idents = concat $ map getLHSIdents lhss
getRegIdents _ = Set.empty
convertModuleItem :: RegIdents -> ModuleItem -> ModuleItem
convertModuleItem idents (MIDecl (Variable dir (Logic mr) ident a me)) =
MIDecl $ Variable dir (t mr) ident a me
where
t = if Set.member ident idents then Reg else Wire
convertModuleItem idents (Generate items) = Generate $ map (convertGenItem $ convertModuleItem idents) items
convertModuleItem _ other = other
convertGenItem :: (ModuleItem -> ModuleItem) -> 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' = fmap convertGenItem' def
idents :: LHS -> Writer RegIdents ()
idents (LHS vx ) = tell $ Set.singleton vx
idents (LHSBit vx _) = tell $ Set.singleton vx
idents (LHSRange vx _) = tell $ Set.singleton vx
idents (LHSConcat lhss) = mapM idents lhss >>= \_ -> return ()
regIdents _ = return ()

10
Convert/StarPort.hs
View File

@ -6,7 +6,7 @@
module Convert.StarPort (convert) where
import Data.Maybe (mapMaybe)
import Control.Monad.Writer
import qualified Data.Map.Strict as Map
import Convert.Traverse
@ -16,10 +16,10 @@ convert :: AST -> AST
convert descriptions =
traverseDescriptions (traverseModuleItems mapInstance) descriptions
where
modulePorts = Map.fromList $ mapMaybe getPorts descriptions
getPorts :: Description -> Maybe (Identifier, [Identifier])
getPorts (Module name ports _) = Just (name, ports)
getPorts _ = Nothing
modulePorts = execWriter $ collectDescriptionsM getPorts descriptions
getPorts :: Description -> Writer (Map.Map Identifier [Identifier]) ()
getPorts (Module name ports _) = tell $ Map.singleton name ports
getPorts _ = return ()
mapInstance :: ModuleItem -> ModuleItem
mapInstance (Instance m p x Nothing) =

53
Convert/Traverse.hs
View File

@ -8,36 +8,51 @@ module Convert.Traverse
( MapperM
, Mapper
, unmonad
, collectify
, traverseDescriptionsM
, traverseDescriptions
, collectDescriptionsM
, traverseModuleItemsM
, traverseModuleItems
, collectModuleItemsM
, traverseStmtsM
, traverseStmts
, collectStmtsM
, traverseStmtLHSsM
, traverseStmtLHSs
, collectStmtLHSsM
) where
import Control.Monad.State
import Language.SystemVerilog.AST
type MapperM s t = t -> (State s) t
type MapperM m t = t -> m t
type Mapper t = t -> t
type CollectorM m t = t -> m ()
unmonad :: (MapperM () a -> MapperM () b) -> Mapper a -> Mapper b
unmonad :: (MapperM (State ()) a -> MapperM (State ()) b) -> Mapper a -> Mapper b
unmonad traverser mapper thing =
evalState (traverser (return . mapper) thing) ()
traverseDescriptionsM :: MapperM s Description -> MapperM s AST
collectify :: Monad m => (MapperM m a -> MapperM m b) -> CollectorM m a -> CollectorM m b
collectify traverser collector thing =
traverser mapper thing >>= \_ -> return ()
where mapper x = collector x >>= \() -> return x
traverseDescriptionsM :: Monad m => MapperM m Description -> MapperM m AST
traverseDescriptionsM mapper descriptions =
mapM mapper descriptions
traverseDescriptions :: Mapper Description -> Mapper AST
traverseDescriptions = unmonad traverseDescriptionsM
collectDescriptionsM :: Monad m => CollectorM m Description -> CollectorM m AST
collectDescriptionsM = collectify traverseDescriptionsM
maybeDo :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
maybeDo _ Nothing = return Nothing
maybeDo fun (Just val) = fun val >>= return . Just
traverseModuleItemsM :: MapperM s ModuleItem -> MapperM s Description
traverseModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m Description
traverseModuleItemsM mapper (Module name ports items) =
mapM fullMapper items >>= return . Module name ports
where
@ -65,8 +80,10 @@ traverseModuleItemsM _ orig = return orig
traverseModuleItems :: Mapper ModuleItem -> Mapper Description
traverseModuleItems = unmonad traverseModuleItemsM
collectModuleItemsM :: Monad m => CollectorM m ModuleItem -> CollectorM m Description
collectModuleItemsM = collectify traverseModuleItemsM
traverseStmtsM :: MapperM s Stmt -> MapperM s ModuleItem
traverseStmtsM :: Monad m => MapperM m Stmt -> MapperM m ModuleItem
traverseStmtsM mapper = moduleItemMapper
where
moduleItemMapper (AlwaysC kw stmt) =
@ -74,6 +91,19 @@ traverseStmtsM mapper = moduleItemMapper
moduleItemMapper (Function ret name decls stmt) =
fullMapper stmt >>= return . Function ret name decls
moduleItemMapper other = return $ other
fullMapper = traverseNestedStmtsM mapper
traverseStmts :: Mapper Stmt -> Mapper ModuleItem
traverseStmts = unmonad traverseStmtsM
collectStmtsM :: Monad m => CollectorM m Stmt -> CollectorM m ModuleItem
collectStmtsM = collectify traverseStmtsM
-- private utility for turning a thing which maps over a single lever of
-- statements into one that maps over the nested statements first, then the
-- higher levels up
traverseNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt
traverseNestedStmtsM mapper = fullMapper
where
fullMapper stmt = mapper stmt >>= cs
cs (Block decls stmts) = mapM fullMapper stmts >>= return . Block decls
cs (Case kw expr cases def) = do
@ -91,5 +121,14 @@ traverseStmtsM mapper = moduleItemMapper
cs (Timing sense stmt) = fullMapper stmt >>= return . Timing sense
cs (Null) = return Null
traverseStmts :: Mapper Stmt -> Mapper ModuleItem
traverseStmts = unmonad traverseStmtsM
traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt
traverseStmtLHSsM mapper = traverseNestedStmtsM stmtMapper
where
stmtMapper (AsgnBlk lhs expr) = mapper lhs >>= \lhs' -> return $ AsgnBlk lhs' expr
stmtMapper (Asgn lhs expr) = mapper lhs >>= \lhs' -> return $ Asgn lhs' expr
stmtMapper other = return other
traverseStmtLHSs :: Mapper LHS -> Mapper Stmt
traverseStmtLHSs = unmonad traverseStmtLHSsM
collectStmtLHSsM :: Monad m => CollectorM m LHS -> CollectorM m Stmt
collectStmtLHSsM = collectify traverseStmtLHSsM