diff options
author | John Ericson <git@JohnEricson.me> | 2020-02-02 15:14:40 -0500 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-02-03 21:15:02 -0500 |
commit | 5e63d9c07c0585b85c8fa340d30aeff0130af3f4 (patch) | |
tree | b866612f1214a8fb8044c6ffa7220a7bb0fcfa99 | |
parent | 54dfa94a36a564e5d092aa566d4670c7e008f152 (diff) | |
download | haskell-5e63d9c07c0585b85c8fa340d30aeff0130af3f4.tar.gz |
Refactor HscMain.finish
I found the old control flow a bit hard to follow; I rewrote it to first
decide whether to desugar, and then use that choice when computing
whether to simplify / what sort of interface file to write.
I hope eventually we will always write post-tc interface files, which
will make the logic of this function even simpler, and continue the
thrust of this refactor.
-rw-r--r-- | compiler/main/HscMain.hs | 62 |
1 files changed, 32 insertions, 30 deletions
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index baa396a1b4..243d612655 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -800,44 +800,34 @@ finish summary tc_result mb_old_hash = do let dflags = hsc_dflags hsc_env target = hscTarget dflags hsc_src = ms_hsc_src summary - should_desugar = - ms_mod summary /= gHC_PRIM && hsc_src == HsSrcFile - mk_simple_iface :: Hsc HscStatus - mk_simple_iface = do - (iface, mb_old_iface_hash, details) <- liftIO $ - hscSimpleIface hsc_env tc_result mb_old_hash - - liftIO $ hscMaybeWriteIface dflags iface mb_old_iface_hash (ms_location summary) - - return $ case (target, hsc_src) of - (HscNothing, _) -> HscNotGeneratingCode iface details - (_, HsBootFile) -> HscUpdateBoot iface details - (_, HsigFile) -> HscUpdateSig iface details - _ -> panic "finish" - if should_desugar - then do - -- We usually desugar even when we are not generating code, otherwise we - -- would miss errors thrown by the desugaring (see #10600). The only - -- exceptions are when the Module is Ghc.Prim or when it is not a - -- HsSrcFile Module. - desugared_guts0 <- hscDesugar' (ms_location summary) tc_result - if target == HscNothing - -- We are not generating code, so we can skip simplification - -- and generate a simple interface. - then mk_simple_iface - else do + -- Desugar, if appropriate + -- + -- We usually desugar even when we are not generating code, otherwise we + -- would miss errors thrown by the desugaring (see #10600). The only + -- exceptions are when the Module is Ghc.Prim or when it is not a + -- HsSrcFile Module. + mb_desugar <- + if ms_mod summary /= gHC_PRIM && hsc_src == HsSrcFile + then Just <$> hscDesugar' (ms_location summary) tc_result + else pure Nothing + + -- Simplify, if appropriate, and (whether we simplified or not) generate an + -- interface file. + case mb_desugar of + -- Just cause we desugared doesn't mean we are generating code, see above. + Just desugared_guts | target /= HscNothing -> do plugins <- liftIO $ readIORef (tcg_th_coreplugins tc_result) - desugared_guts <- hscSimplify' plugins desugared_guts0 + simplified_guts <- hscSimplify' plugins desugared_guts (cg_guts, details) <- {-# SCC "CoreTidy" #-} - liftIO $ tidyProgram hsc_env desugared_guts + liftIO $ tidyProgram hsc_env simplified_guts let !partial_iface = {-# SCC "HscMain.mkPartialIface" #-} -- This `force` saves 2M residency in test T10370 -- See Note [Avoiding space leaks in toIface*] for details. - force (mkPartialIface hsc_env details desugared_guts) + force (mkPartialIface hsc_env details simplified_guts) return HscRecomp { hscs_guts = cg_guts, hscs_mod_location = ms_location summary, @@ -845,8 +835,20 @@ finish summary tc_result mb_old_hash = do hscs_partial_iface = partial_iface, hscs_old_iface_hash = mb_old_hash, hscs_iface_dflags = dflags } - else mk_simple_iface + -- We are not generating code, so we can skip simplification + -- and generate a simple interface. + _ -> do + (iface, mb_old_iface_hash, details) <- liftIO $ + hscSimpleIface hsc_env tc_result mb_old_hash + + liftIO $ hscMaybeWriteIface dflags iface mb_old_iface_hash (ms_location summary) + + return $ case (target, hsc_src) of + (HscNothing, _) -> HscNotGeneratingCode iface details + (_, HsBootFile) -> HscUpdateBoot iface details + (_, HsigFile) -> HscUpdateSig iface details + _ -> panic "finish" {- Note [Writing interface files] |