Refactor HscRecomp constructors:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>
Wed, 16 Oct 2019 09:42:12 +0000 (12:42 +0300)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Tue, 29 Oct 2019 07:47:44 +0000 (03:47 -0400)
Make it evident in the constructors that the final interface is only
available when HscStatus is not HscRecomp.

(When HscStatus == HscRecomp we need to finish the compilation to get
the final interface)

`Maybe ModIface` return value of hscIncrementalCompile and the partial
`expectIface` function are removed.

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

index 1a3ced0..18f22d6 100644 (file)
@@ -150,21 +150,18 @@ compileOne' :: Maybe TcGblEnv
             -> IO HomeModInfo   -- ^ the complete HomeModInfo, if successful
 
 compileOne' m_tc_result mHscMessage
-            hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
+            hsc_env0 summary mod_index nmods mb_old_iface mb_old_linkable
             source_modified0
  = do
 
    debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp)
 
    -- Run the pipeline up to codeGen (so everything up to, but not including, STG)
-   (status, hmi_details, m_iface) <- hscIncrementalCompile
+   (status, hmi_details) <- hscIncrementalCompile
                         always_do_basic_recompilation_check
                         m_tc_result mHscMessage
                         hsc_env summary source_modified mb_old_iface (mod_index, nmods)
 
-   -- Build HMI from the results of the Core pipeline.
-   let coreHmi m_linkable = HomeModInfo (expectIface m_iface) hmi_details m_linkable
-
    let flags = hsc_dflags hsc_env0
      in do unless (gopt Opt_KeepHiFiles flags) $
                addFilesToClean flags TFL_CurrentModule $
@@ -174,27 +171,27 @@ compileOne' m_tc_result mHscMessage
                    [ml_obj_file $ ms_location summary]
 
    case (status, hsc_lang) of
-        (HscUpToDate, _) ->
+        (HscUpToDate iface, _) ->
             -- TODO recomp014 triggers this assert. What's going on?!
-            -- ASSERT( isJust maybe_old_linkable || isNoLink (ghcLink dflags) )
-            return $! coreHmi maybe_old_linkable
-        (HscNotGeneratingCode, HscNothing) ->
+            -- ASSERT( isJust mb_old_linkable || isNoLink (ghcLink dflags) )
+            return $! HomeModInfo iface hmi_details mb_old_linkable
+        (HscNotGeneratingCode iface, HscNothing) ->
             let mb_linkable = if isHsBootOrSig src_flavour
                                 then Nothing
                                 -- TODO: Questionable.
                                 else Just (LM (ms_hs_date summary) this_mod [])
-            in return $! coreHmi mb_linkable
-        (HscNotGeneratingCode, _) -> panic "compileOne HscNotGeneratingCode"
+            in return $! HomeModInfo iface hmi_details mb_linkable
+        (HscNotGeneratingCode _, _) -> panic "compileOne HscNotGeneratingCode"
         (_, HscNothing) -> panic "compileOne HscNothing"
-        (HscUpdateBoot, HscInterpreted) -> do
-            return $! coreHmi Nothing
-        (HscUpdateBoot, _) -> do
+        (HscUpdateBoot iface, HscInterpreted) -> do
+            return $! HomeModInfo iface hmi_details Nothing
+        (HscUpdateBoot iface, _) -> do
             touchObjectFile dflags object_filename
-            return $! coreHmi Nothing
-        (HscUpdateSig, HscInterpreted) ->
+            return $! HomeModInfo iface hmi_details Nothing
+        (HscUpdateSig iface, HscInterpreted) -> do
             let !linkable = LM (ms_hs_date summary) this_mod []
-            in return $! coreHmi (Just linkable)
-        (HscUpdateSig, _) -> do
+            return $! HomeModInfo iface hmi_details (Just linkable)
+        (HscUpdateSig iface, _) -> do
             output_fn <- getOutputFilename next_phase
                             (Temporary TFL_CurrentModule) basename dflags
                             next_phase (Just location)
@@ -206,14 +203,14 @@ compileOne' m_tc_result mHscMessage
                               (output_fn,
                                Nothing,
                                Just (HscOut src_flavour
-                                            mod_name HscUpdateSig))
+                                            mod_name (HscUpdateSig iface)))
                               (Just basename)
                               Persistent
                               (Just location)
                               []
             o_time <- getModificationUTCTime object_filename
             let !linkable = LM o_time this_mod [DotO object_filename]
-            return $! coreHmi $ Just linkable
+            return $! HomeModInfo iface hmi_details (Just linkable)
         (HscRecomp cgguts summary iface_gen, HscInterpreted) -> do
             -- In interpreted mode the regular codeGen backend is not run
             -- so we generate a interface without codeGen info.
@@ -273,10 +270,6 @@ compileOne' m_tc_result mHscMessage
             return $! HomeModInfo iface hmi_details (Just linkable)
 
  where dflags0     = ms_hspp_opts summary
-
-       expectIface :: Maybe ModIface -> ModIface
-       expectIface = expectJust "compileOne': Interface expected "
-
        this_mod    = ms_mod summary
        location    = ms_location summary
        input_fn    = expectJust "compile:hs" (ml_hs_file location)
@@ -1143,7 +1136,7 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
 
   -- run the compiler!
         let msg hsc_env _ what _ = oneShotMsg hsc_env what
-        (result, _, _) <- liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'
+        (result, _) <- liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'
                             mod_summary source_unchanged Nothing (1,1)
 
         return (HscOut src_flavour mod_name result,
@@ -1158,21 +1151,21 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
             next_phase = hscPostBackendPhase src_flavour hsc_lang
 
         case result of
-            HscNotGeneratingCode ->
+            HscNotGeneratingCode ->
                 return (RealPhase StopLn,
                         panic "No output filename from Hsc when no-code")
-            HscUpToDate ->
+            HscUpToDate ->
                 do liftIO $ touchObjectFile dflags o_file
                    -- The .o file must have a later modification date
                    -- than the source file (else we wouldn't get Nothing)
                    -- but we touch it anyway, to keep 'make' happy (we think).
                    return (RealPhase StopLn, o_file)
-            HscUpdateBoot ->
+            HscUpdateBoot ->
                 do -- In the case of hs-boot files, generate a dummy .o-boot
                    -- stamp file for the benefit of Make
                    liftIO $ touchObjectFile dflags o_file
                    return (RealPhase StopLn, o_file)
-            HscUpdateSig ->
+            HscUpdateSig ->
                 do -- We need to create a REAL but empty .o file
                    -- because we are going to attempt to put it in a library
                    PipeState{hsc_env=hsc_env'} <- getPipeState
index 83aa426..9ed2710 100644 (file)
@@ -727,7 +727,7 @@ hscIncrementalCompile :: Bool
                       -> SourceModified
                       -> Maybe ModIface
                       -> (Int,Int)
-                      -> IO (HscStatus, ModDetails, Maybe ModIface)
+                      -> IO (HscStatus, ModDetails)
 hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
     mHscMessage hsc_env' mod_summary source_modified mb_old_iface mod_index
   = do
@@ -768,7 +768,7 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
                 -- in make mode, since this HMI will go into the HPT.
                 details <- genModDetails hsc_env' iface
                 return details
-            return (HscUpToDate, details, Just iface)
+            return (HscUpToDate iface, details)
         -- We finished type checking.  (mb_old_hash is the hash of
         -- the interface that existed on disk; it's possible we had
         -- to retypecheck but the resulting interface is exactly
@@ -791,7 +791,7 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
 finish :: ModSummary
        -> TcGblEnv
        -> Maybe Fingerprint
-       -> Hsc (HscStatus, ModDetails, Maybe ModIface)
+       -> Hsc (HscStatus, ModDetails)
 finish summary tc_result mb_old_hash = do
   hsc_env <- getHscEnv
   let dflags = hsc_dflags hsc_env
@@ -799,19 +799,20 @@ finish summary tc_result mb_old_hash = do
       hsc_src = ms_hsc_src summary
       should_desugar =
         ms_mod summary /= gHC_PRIM && hsc_src == HsSrcFile
-      mk_simple_iface :: Hsc (HscStatus, ModDetails, Maybe ModIface)
+      mk_simple_iface :: Hsc (HscStatus, ModDetails)
       mk_simple_iface = do
-        let hsc_status =
-              case (target, hsc_src) of
-                (HscNothing, _) -> HscNotGeneratingCode
-                (_, HsBootFile) -> HscUpdateBoot
-                (_, HsigFile) -> HscUpdateSig
-                _ -> panic "finish"
         (iface, no_change, details) <- liftIO $
           hscSimpleIface hsc_env tc_result mb_old_hash
 
         liftIO $ hscMaybeWriteIface dflags iface no_change (ms_location summary)
-        return (hsc_status, details, Just iface)
+
+        let hsc_status =
+              case (target, hsc_src) of
+                (HscNothing, _) -> HscNotGeneratingCode iface
+                (_, HsBootFile) -> HscUpdateBoot iface
+                (_, HsigFile) -> HscUpdateSig iface
+                _ -> panic "finish"
+        return (hsc_status, details)
 
   -- we usually desugar even when we are not generating code, otherwise
   -- we would miss errors thrown by the desugaring (see #10600). The only
@@ -849,8 +850,7 @@ finish summary tc_result mb_old_hash = do
                   let no_change = mb_old_hash == Just (mi_iface_hash (mi_final_exts final_iface))
                   return (final_iface, no_change)
 
-          return ( HscRecomp cg_guts summary iface_gen
-                 , details, Nothing )
+          return ( HscRecomp cg_guts summary iface_gen, details )
     else mk_simple_iface
 
 
index eeaa2c2..4b251af 100644 (file)
@@ -231,11 +231,16 @@ import Control.DeepSeq
 
 -- | Status of a compilation to hard-code
 data HscStatus
-    = HscNotGeneratingCode  -- ^ Nothing to do.
-    | HscUpToDate           -- ^ Nothing to do because code already exists.
-    | HscUpdateBoot         -- ^ Update boot file result.
-    | HscUpdateSig          -- ^ Generate signature file (backpack)
-    | HscRecomp             -- ^ Recompile this module.
+    -- | Nothing to do.
+    = HscNotGeneratingCode ModIface
+    -- | Nothing to do because code already exists.
+    | HscUpToDate ModIface
+    -- | Update boot file result.
+    | HscUpdateBoot ModIface
+    -- | Generate signature file (backpack)
+    | HscUpdateSig ModIface
+    -- | Recompile this module.
+    | HscRecomp
         { hscs_guts       :: CgGuts
                             -- ^ Information for the code generator.
         , hscs_summary    :: ModSummary