From e42fbfa23cd7c633a45393291c8cc562069e6720 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Thu, 16 Sep 2021 23:35:16 -0400 Subject: [PATCH] restructure scoper run and eval interface --- src/Convert/Cast.hs | 9 ++- src/Convert/HierConst.hs | 5 +- src/Convert/Interface.hs | 16 ++--- src/Convert/Logic.hs | 14 ++-- src/Convert/Package.hs | 12 ++-- src/Convert/Scoper.hs | 133 +++++++++++++---------------------- src/Convert/UnpackedArray.hs | 9 ++- 7 files changed, 83 insertions(+), 115 deletions(-) diff --git a/src/Convert/Cast.hs b/src/Convert/Cast.hs index e941368..e7ec996 100644 --- a/src/Convert/Cast.hs +++ b/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 () diff --git a/src/Convert/HierConst.hs b/src/Convert/HierConst.hs index 09ec8c0..4d72ac5 100644 --- a/src/Convert/HierConst.hs +++ b/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 diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs index 2890436..57c2055 100644 --- a/src/Convert/Interface.hs +++ b/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) diff --git a/src/Convert/Logic.hs b/src/Convert/Logic.hs index 6d82c24..0b9ba05 100644 --- a/src/Convert/Logic.hs +++ b/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 diff --git a/src/Convert/Package.hs b/src/Convert/Package.hs index 2eb2445..927b634 100644 --- a/src/Convert/Package.hs +++ b/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) diff --git a/src/Convert/Scoper.hs b/src/Convert/Scoper.hs index ed32f1f..9ffa97b 100644 --- a/src/Convert/Scoper.hs +++ b/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 diff --git a/src/Convert/UnpackedArray.hs b/src/Convert/UnpackedArray.hs index fbe2bf5..dca1467 100644 --- a/src/Convert/UnpackedArray.hs +++ b/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