standardized handling of resolution across source files

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

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

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]

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

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

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 ()