restructure scoper run and eval interface

src/Convert/Cast.hs

@@ -41,11 +41,10 @@ convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription description =
-    traverseModuleItems dropDuplicateCaster $
-    partScoper
-        traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
-        description
+convertDescription =
+    traverseModuleItems dropDuplicateCaster . evalScoper . scopePart scoper
+    where scoper = scopeModuleItem
+            traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
 
 type SC = Scoper ()
 

src/Convert/HierConst.hs

@@ -37,11 +37,12 @@ convertDescription (Part attrs extern kw lifetime name ports items) =
             then items'
             else map expand items'
     where
-        (items', mapping) = runScoper traverseDeclM
+        (items', mapping) = runScoper $ scopeModuleItems scoper name items
+        scoper = scopeModuleItem
+            traverseDeclM
             (traverseExprsM traverseExprM)
             (traverseGenItemExprsM traverseExprM)
             (traverseStmtExprsM traverseExprM)
-            name items
         shadowedParams = Map.keys $ Map.filter (fromLeft False) $
             extractMapping mapping
         expand = traverseNestedModuleItems $ expandParam shadowedParams

src/Convert/Interface.hs

@@ -63,11 +63,8 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
         PackageItem $ Decl $ CommentDecl $
             "removed module with interface ports: " ++ name
     where
-        items' = evalScoper
-            traverseDeclM traverseModuleItemM return return name items
-
-        convertNested =
-            scopeModuleItemT traverseDeclM traverseModuleItemM return return
+        items' = evalScoper $ scopeModuleItems scoper name items
+        scoper = scopeModuleItem traverseDeclM traverseModuleItemM return return
 
         traverseDeclM :: Decl -> Scoper [ModportDecl] Decl
         traverseDeclM decl = do
@@ -94,7 +91,7 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
                 return instanceItem
             else if partKind == Interface then
                 -- inline instantiation of an interface
-                convertNested $ Generate $ map GenModuleItem $
+                scoper $ Generate $ map GenModuleItem $
                     inlineInstance modports rs []
                     partItems part instanceName paramBindings portBindings
             else if null modportInstances then
@@ -108,7 +105,7 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
                             ++ " has interface ports "
                             ++ showKeys modportInstances ++ ", but only "
                             ++ showKeys modportBindings ++ " are connected"
-                    else convertNested $ Generate $ map GenModuleItem $
+                    else scoper $ Generate $ map GenModuleItem $
                             inlineInstance modports rs modportBindings partItems
                             part instanceName paramBindings portBindings
             where
@@ -338,12 +335,13 @@ inlineInstance global ranges modportBindings items partName
     wrapInstance instanceName items'
     : portBindings
     where
-        items' = evalScoper traverseDeclM traverseModuleItemM traverseGenItemM
-            traverseStmtM partName $
+        items' = evalScoper $ scopeModuleItems scoper partName $
             map (traverseNestedModuleItems rewriteItem) $
             if null modportBindings
                 then items ++ [typeModport, dimensionModport, bundleModport]
                 else items
+        scoper = scopeModuleItem
+            traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
 
         key = shortHash (partName, instanceName)
 

src/Convert/Logic.hs

@@ -64,15 +64,15 @@ convert =
         collectDeclDirsM _ = return ()
 
 convertDescription :: Ports -> Description -> Description
-convertDescription ports description@(Part _ _ Module _ _ _ _) =
-    -- rewrite reg continuous assignments and output port connections
-    partScoper (rewriteDeclM locations) (traverseModuleItemM ports)
-        return return description
+convertDescription ports description =
+    evalScoper $ scopeModule conScoper description
     where
+        locations = execWriter $ evalScoperT $ scopePart locScoper description
         -- write down which vars are procedurally assigned
-        locations = execWriter $ partScoperT
-            traverseDeclM return return traverseStmtM description
-convertDescription _ other = other
+        locScoper = scopeModuleItem traverseDeclM return return traverseStmtM
+        -- rewrite reg continuous assignments and output port connections
+        conScoper = scopeModuleItem
+            (rewriteDeclM locations) (traverseModuleItemM ports) return return
 
 traverseModuleItemM :: Ports -> ModuleItem -> Scoper Type ModuleItem
 traverseModuleItemM ports = embedScopes $ traverseModuleItem ports

src/Convert/Package.hs

@@ -226,8 +226,7 @@ explicitImport pkg ident = do
 processItems :: Identifier -> Identifier -> [ModuleItem]
     -> PackagesState (IdentStateMap, [ModuleItem])
 processItems topName packageName moduleItems = do
-    (moduleItems', scopes) <- runScoperT
-        traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
+    (moduleItems', scopes) <- runScoperT $ scopeModuleItems scoper
         topName (reorderItems moduleItems)
     let rawIdents = extractMapping scopes
     externalIdentMaps <- mapM (resolveExportMI rawIdents) moduleItems
@@ -239,6 +238,9 @@ processItems topName packageName moduleItems = do
                     else exports
     seq exports return (exports', moduleItems')
     where
+        scoper = scopeModuleItem
+            traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
+
         -- produces partial mappings of exported identifiers, while also
         -- checking the validity of the exports
         resolveExportMI :: IdentStateMap -> ModuleItem -> PackagesState IdentStateMap
@@ -677,9 +679,9 @@ addUsedPIs :: ModuleItem -> (ModuleItem, Idents)
 addUsedPIs item =
     (item, usedPIs)
     where
-        usedPIs = execWriter $ evalScoperT
-            writeDeclIdents writeModuleItemIdents writeGenItemIdents writeStmtIdents
-            "" [item]
+        usedPIs = execWriter $ evalScoperT $ scoper item
+        scoper = scopeModuleItem writeDeclIdents writeModuleItemIdents
+            writeGenItemIdents writeStmtIdents
 
 type IdentWriter = ScoperT () (Writer Idents)
 

src/Convert/Scoper.hs

@@ -30,7 +30,10 @@ module Convert.Scoper
     , runScoper
     , runScoperT
     , partScoper
-    , partScoperT
+    , scopeModuleItem
+    , scopeModuleItems
+    , scopePart
+    , scopeModule
     , accessesToExpr
     , replaceInType
     , replaceInExpr
@@ -60,13 +63,11 @@ module Convert.Scoper
     , loopVarDepthM
     , lookupLocalIdent
     , lookupLocalIdentM
-    , scopeModuleItemT
     , Replacements
     , LookupResult
     ) where
 
 import Control.Monad.State.Strict
-import Data.Functor.Identity (runIdentity)
 import Data.List (findIndices, partition)
 import Data.Maybe (isNothing)
 import qualified Data.Map.Strict as Map
@@ -369,75 +370,57 @@ loopVarDepth scopes x =
 loopVarDepthM :: Monad m => Identifier -> ScoperT a m (Maybe Int)
 loopVarDepthM = embedScopes loopVarDepth
 
-evalScoper
-    :: MapperM (Scoper a) Decl
-    -> MapperM (Scoper a) ModuleItem
-    -> MapperM (Scoper a) GenItem
-    -> MapperM (Scoper a) Stmt
+scopeModuleItems
+    :: Monad m
+    => MapperM (ScoperT a m) ModuleItem
     -> Identifier
-    -> [ModuleItem]
-    -> [ModuleItem]
-evalScoper declMapper moduleItemMapper genItemMapper stmtMapper topName items =
-    runIdentity $ evalScoperT
-    declMapper moduleItemMapper genItemMapper stmtMapper topName items
-
-evalScoperT
-    :: forall a m. Monad m
-    => MapperM (ScoperT a m) Decl
-    -> MapperM (ScoperT a m) ModuleItem
-    -> MapperM (ScoperT a m) GenItem
-    -> MapperM (ScoperT a m) Stmt
-    -> Identifier
-    -> [ModuleItem]
-    -> m [ModuleItem]
-evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items = do
-    (items', _) <- runScoperT
-        declMapper moduleItemMapper genItemMapper stmtMapper
-        topName items
+    -> MapperM (ScoperT a m) [ModuleItem]
+scopeModuleItems moduleItemMapper topName items = do
+    enterScope topName ""
+    items' <- mapM moduleItemMapper items
+    exitScope
     return items'
 
-runScoper
-    :: MapperM (Scoper a) Decl
-    -> MapperM (Scoper a) ModuleItem
-    -> MapperM (Scoper a) GenItem
-    -> MapperM (Scoper a) Stmt
-    -> Identifier
-    -> [ModuleItem]
-    -> ([ModuleItem], Scopes a)
-runScoper declMapper moduleItemMapper genItemMapper stmtMapper topName items =
-    runIdentity $ runScoperT
-    declMapper moduleItemMapper genItemMapper stmtMapper topName items
+scopeModule :: Monad m
+    => MapperM (ScoperT a m) ModuleItem
+    -> MapperM (ScoperT a m) Description
+scopeModule moduleItemMapper description
+    | Part _ _ Module _ _ _ _ <- description =
+        scopePart moduleItemMapper description
+    | otherwise = return description
 
-runScoperT
+scopePart :: Monad m
+    => MapperM (ScoperT a m) ModuleItem
+    -> MapperM (ScoperT a m) Description
+scopePart moduleItemMapper description
+    | Part attrs extern kw liftetime name ports items <- description =
+        scopeModuleItems moduleItemMapper name items >>=
+        return . Part attrs extern kw liftetime name ports
+    | otherwise = return description
+
+evalScoper :: Scoper a x -> x
+evalScoper = flip evalState initialState
+
+evalScoperT :: Monad m => ScoperT a m x -> m x
+evalScoperT = flip evalStateT initialState
+
+runScoper :: Scoper a x -> (x, Scopes a)
+runScoper = flip runState initialState
+
+runScoperT :: Monad m => ScoperT a m x -> m (x, Scopes a)
+runScoperT = flip runStateT initialState
+
+initialState :: Scopes a
+initialState = Scopes [] Map.empty [] [] []
+
+scopeModuleItem
     :: forall a m. Monad m
     => MapperM (ScoperT a m) Decl
     -> MapperM (ScoperT a m) ModuleItem
     -> MapperM (ScoperT a m) GenItem
     -> MapperM (ScoperT a m) Stmt
-    -> Identifier
-    -> [ModuleItem]
-    -> m ([ModuleItem], Scopes a)
-runScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =
-    runStateT operation initialState
-    where
-        operation :: ScoperT a m [ModuleItem]
-        operation = do
-            enterScope topName ""
-            mapM wrappedModuleItemMapper items
-        initialState = Scopes [] Map.empty [] [] []
-
-        wrappedModuleItemMapper = scopeModuleItemT
-            declMapper moduleItemMapper genItemMapper stmtMapper
-
-scopeModuleItemT
-    :: forall a m. Monad m
-    => MapperM (ScoperT a m) Decl
     -> MapperM (ScoperT a m) ModuleItem
-    -> MapperM (ScoperT a m) GenItem
-    -> MapperM (ScoperT a m) Stmt
-    -> ModuleItem
-    -> ScoperT a m ModuleItem
-scopeModuleItemT declMapper moduleItemMapper genItemMapper stmtMapper =
+scopeModuleItem declMapper moduleItemMapper genItemMapper stmtMapper =
     wrappedModuleItemMapper
     where
         fullStmtMapper :: Stmt -> ScoperT a m Stmt
@@ -606,26 +589,8 @@ partScoper
     -> MapperM (Scoper a) ModuleItem
     -> MapperM (Scoper a) GenItem
     -> MapperM (Scoper a) Stmt
-    -> Description
-    -> Description
-partScoper declMapper moduleItemMapper genItemMapper stmtMapper part =
-    runIdentity $ partScoperT
-        declMapper moduleItemMapper genItemMapper stmtMapper part
-
-partScoperT
-    :: Monad m
-    => MapperM (ScoperT a m) Decl
-    -> MapperM (ScoperT a m) ModuleItem
-    -> MapperM (ScoperT a m) GenItem
-    -> MapperM (ScoperT a m) Stmt
-    -> Description
-    -> m Description
-partScoperT declMapper moduleItemMapper genItemMapper stmtMapper =
-    mapper
-    where
-        operation = evalScoperT
+    -> Mapper Description
+partScoper declMapper moduleItemMapper genItemMapper stmtMapper =
+    evalScoper . scopePart scoper
+    where scoper = scopeModuleItem
             declMapper moduleItemMapper genItemMapper stmtMapper
-        mapper (Part attrs extern kw liftetime name ports items) = do
-            items' <- operation name items
-            return $ Part attrs extern kw liftetime name ports items'
-        mapper description = return description

src/Convert/UnpackedArray.hs

@@ -27,11 +27,14 @@ convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
 convertDescription description@(Part _ _ Module _ _ ports _) =
-    partScoper (rewriteDeclM locations) return return return description
+    evalScoper $ scopePart conScoper description
     where
-        locations = execState (operation description) Map.empty
-        operation = partScoperT
+        locations = execState
+            (evalScoperT $ scopePart locScoper description) Map.empty
+        locScoper = scopeModuleItem
             (traverseDeclM ports) traverseModuleItemM return traverseStmtM
+        conScoper = scopeModuleItem
+            (rewriteDeclM locations) return return return
 convertDescription other = other
 
 -- tracks multi-dimensional unpacked array declarations