experimenting with monad helpers

src/Convert/Interface.hs

@@ -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

src/Convert/MultiplePacked.hs

@@ -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

src/Convert/Package.hs

@@ -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

src/Convert/Struct.hs

@@ -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

src/Convert/Traverse.hs

@@ -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

src/Convert/UnpackedArray.hs

@@ -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