(manual) Revert "WIP (load only files that contain at least one usefu…

…l EntitySymbol)"

This reverts commit 720e702

Running ghc-prof-flamegraph shows that accessed_files takes more
than half the resources that buildGCModule consumes. Let's revert
this and consider alternative approaches.

asterius/src/Asterius/Ar.hs

@@ -35,7 +35,6 @@ where
 
 import Asterius.Binary.ByteString
 import Asterius.Types
-import qualified Asterius.Types.SymbolMap as SM
 import Control.Monad
 import Data.Binary.Get
 import Data.Binary.Put
@@ -173,11 +172,7 @@ loadArchiveRep ncu path = do
     Left {} -> pure mempty -- Note [Malformed object files] in Asterius.Ld
     Right m -> pure m
   let combined = mconcat ms
-  pure
-    combined
-      { archiveSources = Set.singleton path,
-        symbolOrigin = SM.fromList [(k, path) | k <- SM.keys $ dependencyMap combined]
-      }
+  pure combined {archiveSources = Set.singleton path}
 
 loadArchiveFile :: GHC.NameCacheUpdater -> FilePath -> (AsteriusModule -> AsteriusModule) -> IO AsteriusModule
 loadArchiveFile ncu path fn = do

asterius/src/Asterius/Passes/GCSections.hs

@@ -103,12 +103,12 @@ gcModule mod_syms export_funcs m =
 -- approach thus depends on two important assumptions: (a) for each JSFFI
 -- import, @<name>@ and @<name>_wrapper@ are always in the same module, and (b)
 -- the keys of the @sptMap@ refer only to statics in the same module.
-loadFilterEverything :: AsteriusRepModule -> Set.Set FilePath -> (AsteriusModule -> AsteriusModule) -> IO AsteriusModule
-loadFilterEverything AsteriusRepModule {..} accessed_files fn = do
+loadFilterEverything :: AsteriusRepModule -> (AsteriusModule -> AsteriusModule) -> IO AsteriusModule
+loadFilterEverything AsteriusRepModule {..} fn = do
   ncu <- newNameCacheUpdater
-  objs <- for [p | p <- Set.toList objectSources, p `Set.member` accessed_files] $ \path ->
+  objs <- for (Set.toList objectSources) $ \path ->
     fn <$> loadObjectFile ncu path
-  arcs <- for [p | p <- Set.toList archiveSources, p `Set.member` accessed_files] $ \path ->
+  arcs <- for (Set.toList archiveSources) $ \path ->
     loadArchiveFile ncu path fn
   pure $ fn inMemoryModule <> mconcat objs <> mconcat arcs
 
@@ -126,14 +126,9 @@ fromAsteriusRepModule AsteriusRepModule {..} = do
 
 buildGCModule :: SS.SymbolSet -> SS.SymbolSet -> AsteriusRepModule -> SS.SymbolSet -> IO AsteriusModule
 buildGCModule mod_syms err_syms module_rep export_funcs = do
-  everything <- loadFilterEverything module_rep accessed_files (gcModule mod_syms export_funcs)
+  everything <- loadFilterEverything module_rep (gcModule mod_syms export_funcs)
   pure everything {staticsMap = staticsMap everything <> err_statics}
   where
-    accessed_files =
-      Set.fromList
-        $ catMaybes
-        $ map (`SM.lookup` symbolOrigin module_rep)
-        $ SS.toList mod_syms
     err_statics =
       SM.fromList
         [ ( "__asterius_barf_" <> sym,

asterius/src/Asterius/Types.hs

@@ -189,10 +189,7 @@ mkModuleExports m =
 loadObjectRep :: GHC.NameCacheUpdater -> FilePath -> IO AsteriusRepModule
 loadObjectRep ncu path = tryGetFile ncu path >>= \case
   Left {} -> pure mempty -- Note [Malformed object files] in Asterius.Ld
-  Right m -> pure m
-               { objectSources = Set.singleton path,
-                 symbolOrigin = SM.fromList [ (k, path) | k <- SM.keys $ dependencyMap m ]
-               }
+  Right m -> pure m {objectSources = Set.singleton path}
 
 -- | Load a module in its entirety from disk.
 loadObjectFile :: GHC.NameCacheUpdater -> FilePath -> IO AsteriusModule
@@ -230,8 +227,6 @@ data AsteriusRepModule
         objectSources :: Set.Set FilePath,
         -- | (not on disk) Archive file dependencies.
         archiveSources :: Set.Set FilePath,
-        -- | (not on disk) Source-file origin for all symbols that come from disk.
-        symbolOrigin :: SymbolMap FilePath,
         -- | (not on disk) In-memory parts of the module that are not yet stored anywhere on disk yet.
         inMemoryModule :: AsteriusModule
       }
@@ -252,24 +247,22 @@ instance GHC.Binary AsteriusRepModule where
         moduleExports = exports,
         objectSources = mempty,  -- It is set later.
         archiveSources = mempty, -- It is set later.
-        symbolOrigin = mempty,   -- It is set later.
         inMemoryModule = mempty
       }
 
   put_ _ _ = error "GHC.Binary.put_: AsteriusRepModule"
 
 instance Semigroup AsteriusRepModule where
-  AsteriusRepModule dm0 out0 osrc0 asrc0 or0 inmem0 <> AsteriusRepModule dm1 out1 osrc1 asrc1 or1 inmem1 =
+  AsteriusRepModule dm0 out0 osrc0 asrc0 inmem0 <> AsteriusRepModule dm1 out1 osrc1 asrc1 inmem1 =
     AsteriusRepModule
       (dm0 <> dm1)
       (out0 <> out1)
       (osrc0 <> osrc1)
       (asrc0 <> asrc1)
-      (or0 <> or1)
       (inmem0 <> inmem1)
 
 instance Monoid AsteriusRepModule where
-  mempty = AsteriusRepModule mempty mempty mempty mempty mempty mempty
+  mempty = AsteriusRepModule mempty mempty mempty mempty mempty
 
 -- | Convert an 'AsteriusModule' to an 'AsteriusRepModule' by laboriously
 -- computing the dependency graph for each 'EntitySymbol' and all the
@@ -281,7 +274,6 @@ toAsteriusRepModule m =
       moduleExports = mkModuleExports m,
       objectSources = mempty,
       archiveSources = mempty,
-      symbolOrigin = mempty,
       inMemoryModule = m
     }