Only pass mod_location with HscRecomp instead of the entire ModSummary
authorÖmer Sinan Ağacan <omeragacan@gmail.com>
Mon, 11 Nov 2019 11:15:55 +0000 (14:15 +0300)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Wed, 13 Nov 2019 12:09:18 +0000 (07:09 -0500)
HscRecomp users only need the ModLocation of the module being compiled,
so only pass that to users instead of the entire ModSummary

Metric Decrease:
    T4801

compiler/main/DriverPipeline.hs
compiler/main/HscMain.hs
compiler/main/HscTypes.hs

index 4d418b9..ff0186a 100644 (file)
@@ -219,16 +219,16 @@ compileOne' m_tc_result mHscMessage
             let !linkable = LM o_time this_mod [DotO object_filename]
             return $! HomeModInfo iface hmi_details (Just linkable)
         (HscRecomp { hscs_guts = cgguts,
-                     hscs_summary = summary,
+                     hscs_mod_location = mod_location,
                      hscs_partial_iface = partial_iface,
                      hscs_old_iface_hash = mb_old_iface_hash,
                      hscs_iface_dflags = iface_dflags }, HscInterpreted) -> do
             -- In interpreted mode the regular codeGen backend is not run so we
             -- generate a interface without codeGen info.
             final_iface <- mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface
-            liftIO $ hscMaybeWriteIface dflags final_iface mb_old_iface_hash (ms_location summary)
+            liftIO $ hscMaybeWriteIface dflags final_iface mb_old_iface_hash mod_location
 
-            (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env' cgguts summary
+            (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env' cgguts mod_location
 
             stub_o <- case hasStub of
                       Nothing -> return []
@@ -1176,7 +1176,7 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
                    liftIO $ compileEmptyStub dflags hsc_env' basename location mod_name
                    return (RealPhase StopLn, o_file)
             HscRecomp { hscs_guts = cgguts,
-                        hscs_summary = mod_summary,
+                        hscs_mod_location = mod_location,
                         hscs_partial_iface = partial_iface,
                         hscs_old_iface_hash = mb_old_iface_hash,
                         hscs_iface_dflags = iface_dflags }
@@ -1185,15 +1185,14 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
                     PipeState{hsc_env=hsc_env'} <- getPipeState
 
                     (outputFilename, mStub, foreign_files) <- liftIO $
-                      hscGenHardCode hsc_env' cgguts mod_summary output_fn
+                      hscGenHardCode hsc_env' cgguts mod_location output_fn
 
                     final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface)
                     setIface final_iface
 
                     -- See Note [Writing interface files]
                     let if_dflags = dflags `gopt_unset` Opt_BuildDynamicToo
-                    liftIO $ hscMaybeWriteIface if_dflags final_iface mb_old_iface_hash
-                                                    (ms_location mod_summary)
+                    liftIO $ hscMaybeWriteIface if_dflags final_iface mb_old_iface_hash mod_location
 
                     stub_o <- liftIO (mapM (compileStub hsc_env') mStub)
                     foreign_os <- liftIO $
index 83c69af..3d2ac98 100644 (file)
@@ -840,7 +840,7 @@ finish summary tc_result mb_old_hash = do
                 force (mkPartialIface hsc_env details desugared_guts)
 
           return ( HscRecomp { hscs_guts = cg_guts,
-                               hscs_summary = summary,
+                               hscs_mod_location = ms_location summary,
                                hscs_partial_iface = partial_iface,
                                hscs_old_iface_hash = mb_old_hash,
                                hscs_iface_dflags = dflags },
@@ -1405,10 +1405,10 @@ hscWriteIface dflags iface no_change mod_location = do
         in  addBootSuffix_maybe (mi_boot iface) with_hi
 
 -- | Compile to hard-code.
-hscGenHardCode :: HscEnv -> CgGuts -> ModSummary -> FilePath
+hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath
                -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)])
                -- ^ @Just f@ <=> _stub.c is f
-hscGenHardCode hsc_env cgguts mod_summary output_filename = do
+hscGenHardCode hsc_env cgguts location output_filename = do
         let CgGuts{ -- This is the last use of the ModGuts in a compilation.
                     -- From now on, we just use the bits we need.
                     cg_module   = this_mod,
@@ -1419,7 +1419,6 @@ hscGenHardCode hsc_env cgguts mod_summary output_filename = do
                     cg_dep_pkgs = dependencies,
                     cg_hpc_info = hpc_info } = cgguts
             dflags = hsc_dflags hsc_env
-            location = ms_location mod_summary
             data_tycons = filter isDataTyCon tycons
             -- cg_tycons includes newtypes, for the benefit of External Core,
             -- but we don't generate any code for newtypes
@@ -1473,9 +1472,9 @@ hscGenHardCode hsc_env cgguts mod_summary output_filename = do
 
 hscInteractive :: HscEnv
                -> CgGuts
-               -> ModSummary
+               -> ModLocation
                -> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
-hscInteractive hsc_env cgguts mod_summary = do
+hscInteractive hsc_env cgguts location = do
     let dflags = hsc_dflags hsc_env
     let CgGuts{ -- This is the last use of the ModGuts in a compilation.
                 -- From now on, we just use the bits we need.
@@ -1486,7 +1485,6 @@ hscInteractive hsc_env cgguts mod_summary = do
                cg_modBreaks = mod_breaks,
                cg_spt_entries = spt_entries } = cgguts
 
-        location = ms_location mod_summary
         data_tycons = filter isDataTyCon tycons
         -- cg_tycons includes newtypes, for the benefit of External Core,
         -- but we don't generate any code for newtypes
index afc3e72..6bc0904 100644 (file)
@@ -243,7 +243,7 @@ data HscStatus
     | HscRecomp
         { hscs_guts       :: CgGuts
           -- ^ Information for the code generator.
-        , hscs_summary    :: ModSummary
+        , hscs_mod_location :: !ModLocation
           -- ^ Module info
         , hscs_partial_iface  :: !PartialModIface
           -- ^ Partial interface