From 04337988ccdcd203e5f9d821a28f7191c919a564 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Tue, 30 Apr 2019 15:44:52 -0400 Subject: [PATCH] standardized handling of resolution across source files --- src/Convert/Interface.hs | 12 ++++------ src/Convert/Logic.hs | 7 +++--- src/Convert/Package.hs | 22 +++++------------ src/Convert/StarPort.hs | 51 +++++++++++++++++++++------------------- src/Convert/Traverse.hs | 26 ++++++++++++++++++++ src/Convert/Typedef.hs | 12 ++++------ 6 files changed, 72 insertions(+), 58 deletions(-) diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs index 2c5c248..d1cbeac 100644 --- a/src/Convert/Interface.hs +++ b/src/Convert/Interface.hs @@ -21,14 +21,12 @@ type Modports = Map.Map Identifier [ModportDecl] type Modules = Map.Map (Identifier, Identifier) Type convert :: [AST] -> [AST] -convert descriptions = - map ( - filter (not . isInterface) . - traverseDescriptions (convertDescription interfaces modules) - ) descriptions +convert = + traverseFiles (collectDescriptionsM collectDesc) converter where - (interfaces, modules) = - execWriter $ collectDescriptionsM collectDesc $ concat descriptions + converter (interfaces, modules) = + filter (not . isInterface) . + map (convertDescription interfaces modules) -- we can only collect/map non-extern interfaces collectDesc :: Description -> Writer (Interfaces, Modules) () collectDesc (orig @ (Part False kw _ name ports items)) = do diff --git a/src/Convert/Logic.hs b/src/Convert/Logic.hs index 362342a..d2fe321 100644 --- a/src/Convert/Logic.hs +++ b/src/Convert/Logic.hs @@ -36,10 +36,11 @@ type Idents = Set.Set Identifier type Ports = Map.Map (Identifier, Identifier) Direction convert :: [AST] -> [AST] -convert asts = - map (traverseDescriptions $ convertDescription ports) asts +convert = + traverseFiles + (collectDescriptionsM collectPortsM) + (traverseDescriptions . convertDescription) where - ports = execWriter $ collectDescriptionsM collectPortsM $ concat asts collectPortsM :: Description -> Writer Ports () collectPortsM (orig @ (Part _ _ _ name portNames _)) = collectModuleItemsM collectPortDirsM orig diff --git a/src/Convert/Package.hs b/src/Convert/Package.hs index c880512..78ceeb1 100644 --- a/src/Convert/Package.hs +++ b/src/Convert/Package.hs @@ -21,12 +21,6 @@ - * If there is an explicit import of that identifier, the identifier refers to - the imported declaration. - * Usages of conflicting wildcard imports are not allowed. - - - - If a package cannot be found within a file that references it (including - - through files it imports), we fall back to an arbitrary package with the - - given name, if it exists. While this isn't foolproof, some projects do rely - - on their toolchain to locate their packages in other files, much like modules - - or interfaces. -} module Convert.Package (convert) where @@ -43,8 +37,7 @@ type PackageItems = Map.Map Identifier PackageItem type Idents = Set.Set Identifier convert :: [AST] -> [AST] -convert asts = - step asts +convert = step where step :: [AST] -> [AST] step curr = @@ -52,12 +45,12 @@ convert asts = then curr else step next where - packages = execWriter $ - collectDescriptionsM collectDescriptionM $ concat curr - next = map (convertFile packages) curr + next = traverseFiles + (collectDescriptionsM collectDescriptionM) + convertFile curr convertFile :: Packages -> AST -> AST -convertFile globalPackages ast = +convertFile packages ast = (++) globalItems $ filter (not . isCollected) $ traverseDescriptions (traverseDescription packages) $ @@ -65,11 +58,8 @@ convertFile globalPackages ast = where globalItems = map PackageItem $ concatMap (uncurry globalPackageItems) $ Map.toList packages - localPackages = execWriter $ - collectDescriptionsM collectDescriptionM ast - packages = Map.union localPackages globalPackages isCollected :: Description -> Bool - isCollected (Package _ name _) = Map.member name localPackages + isCollected (Package _ name _) = Map.member name packages isCollected _ = False globalPackageItems :: Identifier -> PackageItems -> [PackageItem] diff --git a/src/Convert/StarPort.hs b/src/Convert/StarPort.hs index 93c6532..dda5f37 100644 --- a/src/Convert/StarPort.hs +++ b/src/Convert/StarPort.hs @@ -12,28 +12,31 @@ import qualified Data.Map.Strict as Map import Convert.Traverse import Language.SystemVerilog.AST -convert :: [AST] -> [AST] -convert asts = - map (traverseDescriptions $ traverseModuleItems mapInstance) asts - where - modulePorts = execWriter $ collectDescriptionsM getPorts $ concat asts - getPorts :: Description -> Writer (Map.Map Identifier [Identifier]) () - getPorts (Part _ _ _ name ports _) = tell $ Map.singleton name ports - getPorts _ = return () +type Ports = Map.Map Identifier [Identifier] - mapInstance :: ModuleItem -> ModuleItem - mapInstance (Instance m p x r bindings) = - Instance m p x r $ concatMap expandBinding bindings - where - alreadyBound :: [Identifier] - alreadyBound = map fst bindings - expandBinding :: PortBinding -> [PortBinding] - expandBinding ("*", Nothing) = - case Map.lookup m modulePorts of - Just l -> - map (\port -> (port, Just $ Ident port)) $ - filter (\s -> not $ elem s alreadyBound) $ l - -- if we can't find it, just skip :( - Nothing -> [("*", Nothing)] - expandBinding other = [other] - mapInstance other = other +convert :: [AST] -> [AST] +convert = + traverseFiles + (collectDescriptionsM collectPortsM) + (traverseDescriptions . traverseModuleItems . mapInstance) + +collectPortsM :: Description -> Writer Ports () +collectPortsM (Part _ _ _ name ports _) = tell $ Map.singleton name ports +collectPortsM _ = return () + +mapInstance :: Ports -> ModuleItem -> ModuleItem +mapInstance modulePorts (Instance m p x r bindings) = + Instance m p x r $ concatMap expandBinding bindings + where + alreadyBound :: [Identifier] + alreadyBound = map fst bindings + expandBinding :: PortBinding -> [PortBinding] + expandBinding ("*", Nothing) = + case Map.lookup m modulePorts of + Just l -> + map (\port -> (port, Just $ Ident port)) $ + filter (\s -> not $ elem s alreadyBound) $ l + -- if we can't find it, just skip :( + Nothing -> [("*", Nothing)] + expandBinding other = [other] +mapInstance _ other = other diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index daf9417..e16af0e 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -76,9 +76,11 @@ module Convert.Traverse , traverseScopesM , scopedConversion , stately +, traverseFiles ) where import Control.Monad.State +import Control.Monad.Writer import Language.SystemVerilog.AST type MapperM m t = t -> m t @@ -1009,3 +1011,27 @@ stately :: (Eq s, Show s) => (s -> Mapper a) -> MapperM (State s) a stately mapper thing = do s <- get return $ mapper s thing + +-- In many conversions, we want to resolve items locally first, and then fall +-- back to looking at other source files, if necessary. This helper captures +-- this behavior, allowing a conversion to fall back to arbitrary global +-- collected item, if one exists. While this isn't foolproof (we could +-- inadvertently resolve a name that doesn't exist in the given file), many +-- projects rely on their toolchain to locate their modules, interfaces, +-- packages, or typenames in other files. Global resolution of modules and +-- interfaces is more commonly expected than global resolution of typenames and +-- packages. +traverseFiles + :: Monoid w + => CollectorM (Writer w) AST + -> (w -> Mapper AST) + -> Mapper [AST] +traverseFiles fileCollectorM fileMapper files = + map traverseFile files + where + globalNotes = execWriter $ mapM fileCollectorM files + traverseFile file = + fileMapper notes file + where + localNotes = execWriter $ fileCollectorM file + notes = localNotes <> globalNotes diff --git a/src/Convert/Typedef.hs b/src/Convert/Typedef.hs index b87cb3e..9510cfa 100644 --- a/src/Convert/Typedef.hs +++ b/src/Convert/Typedef.hs @@ -18,15 +18,11 @@ import Language.SystemVerilog.AST type Types = Map.Map Identifier Type convert :: [AST] -> [AST] -convert = map convertFile - -convertFile :: AST -> AST -convertFile descriptions = - traverseDescriptions removeTypedef $ - traverseDescriptions (convertDescription types) $ - descriptions +convert = + traverseFiles + (collectDescriptionsM getTypedef) + (\a -> traverseDescriptions $ removeTypedef . convertDescription a) where - types = execWriter $ collectDescriptionsM getTypedef descriptions getTypedef :: Description -> Writer Types () getTypedef (PackageItem (Typedef a b)) = tell $ Map.singleton b a getTypedef _ = return ()