diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2019-10-16 12:42:12 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-10-29 03:47:44 -0400 |
commit | 3bd3456f144fa801a409147a80673f88360c16a2 (patch) | |
tree | e0e790f4e5953a6b9daba83a5e96a4f212b629d0 /compiler | |
parent | ebee0d6b902ee50467e8471a3676ba652679b27d (diff) | |
download | haskell-3bd3456f144fa801a409147a80673f88360c16a2.tar.gz |
Refactor HscRecomp constructors:
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.
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/main/DriverPipeline.hs | 51 | ||||
-rw-r--r-- | compiler/main/HscMain.hs | 26 | ||||
-rw-r--r-- | compiler/main/HscTypes.hs | 15 |
3 files changed, 45 insertions, 47 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 1a3ced0fd9..18f22d6d78 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -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 diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 83aa4264f1..9ed2710ee8 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -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 diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index eeaa2c2f1d..4b251af436 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -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 |