mirror of https://github.com/zachjs/sv2v.git
experimenting with monad helpers
This commit is contained in:
Zachary Snow
parent
4026ae8fa5
commit
bd1c07231f
|
|
@ -41,10 +41,9 @@ convert =
|
|||
-- we can only collect/map non-extern interfaces
|
||||
collectDesc :: Description -> Writer (Interfaces, Modules) ()
|
||||
collectDesc (orig @ (Part _ False kw _ name ports items)) = do
|
||||
if kw == Interface then
|
||||
if all fullyResolved items
|
||||
then tell (Map.singleton name (ports, items), Map.empty)
|
||||
else return ()
|
||||
if kw == Interface
|
||||
then when (all fullyResolved items) $
|
||||
tell (Map.singleton name (ports, items), Map.empty)
|
||||
else tell (Map.empty, Map.singleton name (params, decls))
|
||||
where
|
||||
params = map fst $ parameters items
|
||||
|
|
@ -85,13 +84,11 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
|
|||
collectInstanceM (MIPackageItem (Decl (Variable _ t ident _ _))) =
|
||||
case t of
|
||||
InterfaceT interfaceName (Just modportName) [] ->
|
||||
if Map.member interfaceName interfaces
|
||||
then writeModport interfaceName modportName
|
||||
else return ()
|
||||
when (Map.member interfaceName interfaces) $
|
||||
writeModport interfaceName modportName
|
||||
Alias Nothing interfaceName [] ->
|
||||
if Map.member interfaceName interfaces
|
||||
then writeModport interfaceName ""
|
||||
else return ()
|
||||
when (Map.member interfaceName interfaces) $
|
||||
writeModport interfaceName ""
|
||||
_ -> return ()
|
||||
where
|
||||
writeModport :: Identifier -> Identifier ->
|
||||
|
|
@ -100,9 +97,8 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
|
|||
tell (Map.empty, Map.singleton ident modport)
|
||||
where modport = (interfaceName, modportName)
|
||||
collectInstanceM (Instance part _ ident [] _) =
|
||||
if Map.member part interfaces
|
||||
then tell (Map.singleton ident part, Map.empty)
|
||||
else return ()
|
||||
when (Map.member part interfaces) $
|
||||
tell (Map.singleton ident part, Map.empty)
|
||||
collectInstanceM _ = return ()
|
||||
|
||||
expandInterface :: ModuleItem -> ModuleItem
|
||||
|
|
@ -440,9 +436,8 @@ inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) =
|
|||
mapM (collectDeclsM collectDeclDir) itemsPrefixed
|
||||
collectDeclDir :: Decl -> Writer (Map.Map Identifier Direction) ()
|
||||
collectDeclDir (Variable dir _ ident _ _) =
|
||||
if dir /= Local
|
||||
then tell $ Map.singleton ident dir
|
||||
else return ()
|
||||
when (dir /= Local) $
|
||||
tell $ Map.singleton ident dir
|
||||
collectDeclDir _ = return ()
|
||||
|
||||
toLHS :: Expr -> LHS
|
||||
|
|
|
|||
|
|
@ -118,13 +118,13 @@ combineRanges r1 r2 = r
|
|||
(BinOp Sub lower (Number "1"))
|
||||
|
||||
traverseModuleItemM :: ModuleItem -> State Info ModuleItem
|
||||
traverseModuleItemM item =
|
||||
traverseLHSsM traverseLHSM item >>=
|
||||
traverseModuleItemM =
|
||||
traverseLHSsM traverseLHSM >=>
|
||||
traverseExprsM traverseExprM
|
||||
|
||||
traverseStmtM :: Stmt -> State Info Stmt
|
||||
traverseStmtM stmt =
|
||||
traverseStmtLHSsM traverseLHSM stmt >>=
|
||||
traverseStmtM =
|
||||
traverseStmtLHSsM traverseLHSM >=>
|
||||
traverseStmtExprsM traverseExprM
|
||||
|
||||
traverseExprM :: Expr -> State Info Expr
|
||||
|
|
|
|||
|
|
@ -123,13 +123,13 @@ prefixPackageItem packageName idents item =
|
|||
convertLHSM (LHSIdent x) = prefixM x >>= return . LHSIdent
|
||||
convertLHSM other = return other
|
||||
|
||||
convertModuleItemM x = return x >>=
|
||||
(traverseTypesM convertTypeM) >>=
|
||||
(traverseExprsM $ traverseNestedExprsM convertExprM) >>=
|
||||
(traverseLHSsM $ traverseNestedLHSsM convertLHSM )
|
||||
convertStmtM stmt = return stmt >>=
|
||||
(traverseStmtExprsM $ traverseNestedExprsM convertExprM) >>=
|
||||
(traverseStmtLHSsM $ traverseNestedLHSsM convertLHSM )
|
||||
convertModuleItemM =
|
||||
traverseTypesM convertTypeM >=>
|
||||
traverseExprsM (traverseNestedExprsM convertExprM) >=>
|
||||
traverseLHSsM (traverseNestedLHSsM convertLHSM )
|
||||
convertStmtM =
|
||||
traverseStmtExprsM (traverseNestedExprsM convertExprM) >=>
|
||||
traverseStmtLHSsM (traverseNestedLHSsM convertLHSM )
|
||||
|
||||
MIPackageItem item'' =
|
||||
evalState
|
||||
|
|
|
|||
|
|
@ -52,21 +52,21 @@ convertDescription (description @ Part{}) =
|
|||
let MIPackageItem (Decl decl'') = res
|
||||
return decl''
|
||||
traverseModuleItemM :: ModuleItem -> State Types ModuleItem
|
||||
traverseModuleItemM item =
|
||||
traverseLHSsM traverseLHSM item >>=
|
||||
traverseExprsM traverseExprM >>=
|
||||
traverseModuleItemM =
|
||||
traverseLHSsM traverseLHSM >=>
|
||||
traverseExprsM traverseExprM >=>
|
||||
traverseAsgnsM traverseAsgnM
|
||||
traverseStmtM :: Stmt -> State Types Stmt
|
||||
traverseStmtM (Subroutine expr args) = do
|
||||
stateTypes <- get
|
||||
let stmt' = Subroutine expr $ convertCall
|
||||
structs stateTypes expr args
|
||||
traverseStmtLHSsM traverseLHSM stmt' >>=
|
||||
traverseStmtExprsM traverseExprM >>=
|
||||
traverseStmtAsgnsM traverseAsgnM
|
||||
traverseStmtM stmt =
|
||||
traverseStmtLHSsM traverseLHSM stmt >>=
|
||||
traverseStmtExprsM traverseExprM >>=
|
||||
traverseStmtM' stmt'
|
||||
traverseStmtM stmt = traverseStmtM' stmt
|
||||
traverseStmtM' :: Stmt -> State Types Stmt
|
||||
traverseStmtM' =
|
||||
traverseStmtLHSsM traverseLHSM >=>
|
||||
traverseStmtExprsM traverseExprM >=>
|
||||
traverseStmtAsgnsM traverseAsgnM
|
||||
traverseExprM =
|
||||
traverseNestedExprsM $ stately converter
|
||||
|
|
|
|||
|
|
@ -122,9 +122,9 @@ unmonad :: (MapperM Identity a -> MapperM Identity b) -> Mapper a -> Mapper b
|
|||
unmonad traverser mapper = runIdentity . traverser (return . mapper)
|
||||
|
||||
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
|
||||
collectify traverser collector =
|
||||
traverser mapper >=> \_ -> return ()
|
||||
where mapper x = collector x >> return x
|
||||
|
||||
traverseDescriptionsM :: Monad m => MapperM m Description -> MapperM m AST
|
||||
traverseDescriptionsM = mapM
|
||||
|
|
|
|||
|
|
@ -61,11 +61,11 @@ packDecl _ other = other
|
|||
|
||||
|
||||
traverseModuleItemM :: ModuleItem -> ST ModuleItem
|
||||
traverseModuleItemM item =
|
||||
traverseModuleItemM' item
|
||||
>>= traverseLHSsM traverseLHSM
|
||||
>>= traverseExprsM traverseExprM
|
||||
>>= traverseAsgnsM traverseAsgnM
|
||||
traverseModuleItemM =
|
||||
traverseModuleItemM'
|
||||
>=> traverseLHSsM traverseLHSM
|
||||
>=> traverseExprsM traverseExprM
|
||||
>=> traverseAsgnsM traverseAsgnM
|
||||
|
||||
traverseModuleItemM' :: ModuleItem -> ST ModuleItem
|
||||
traverseModuleItemM' (Instance a b c d bindings) = do
|
||||
|
|
@ -80,9 +80,9 @@ traverseModuleItemM' (Instance a b c d bindings) = do
|
|||
traverseModuleItemM' other = return other
|
||||
|
||||
traverseStmtM :: Stmt -> ST Stmt
|
||||
traverseStmtM stmt =
|
||||
traverseStmtLHSsM traverseLHSM stmt >>=
|
||||
traverseStmtExprsM traverseExprM >>=
|
||||
traverseStmtM =
|
||||
traverseStmtLHSsM traverseLHSM >=>
|
||||
traverseStmtExprsM traverseExprM >=>
|
||||
traverseStmtAsgnsM traverseAsgnM
|
||||
|
||||
traverseExprM :: Expr -> ST Expr
|
||||
|
|
|
|||
Loading…
Reference in New Issue