diff options
Diffstat (limited to 'compiler/main/HscMain.hs')
| -rw-r--r-- | compiler/main/HscMain.hs | 49 |
1 files changed, 26 insertions, 23 deletions
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index c97e3ec724..e884fe5bcf 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -303,7 +303,7 @@ hscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do -- "name not found", and the Maybe in the return type -- is used to indicate that. -hscTcRnGetInfo :: HscEnv -> Name -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst Branched])) +hscTcRnGetInfo :: HscEnv -> Name -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst])) hscTcRnGetInfo hsc_env0 name = runInteractiveHsc hsc_env0 $ do hsc_env <- getHscEnv ioMsgMaybe' $ tcRnGetInfo hsc_env name @@ -616,10 +616,11 @@ genericHscFrontend mod_summary -- Compile Haskell, boot and extCore in OneShot mode. hscCompileOneShot :: HscEnv + -> FilePath -> ModSummary -> SourceModified -> IO HscStatus -hscCompileOneShot hsc_env mod_summary src_changed +hscCompileOneShot hsc_env extCore_filename mod_summary src_changed = do -- One-shot mode needs a knot-tying mutable variable for interface -- files. See TcRnTypes.TcGblEnv.tcg_type_env_var. @@ -636,6 +637,7 @@ hscCompileOneShot hsc_env mod_summary src_changed compile mb_old_hash reason = runHsc hsc_env' $ do liftIO $ msg reason tc_result <- genericHscFrontend mod_summary + guts0 <- hscDesugar' (ms_location mod_summary) tc_result dflags <- getDynFlags case hscTarget dflags of HscNothing -> return HscNotGeneratingCode @@ -646,9 +648,8 @@ hscCompileOneShot hsc_env mod_summary src_changed liftIO $ hscWriteIface dflags iface changed mod_summary return HscUpdateBoot _ -> - do guts0 <- hscDesugar' (ms_location mod_summary) tc_result - guts <- hscSimplify' guts0 - (iface, changed, _details, cgguts) <- hscNormalIface' guts mb_old_hash + do guts <- hscSimplify' guts0 + (iface, changed, _details, cgguts) <- hscNormalIface' extCore_filename guts mb_old_hash liftIO $ hscWriteIface dflags iface changed mod_summary return $ HscRecomp cgguts mod_summary @@ -1082,16 +1083,18 @@ hscSimpleIface' tc_result mb_old_iface = do return (new_iface, no_change, details) hscNormalIface :: HscEnv + -> FilePath -> ModGuts -> Maybe Fingerprint -> IO (ModIface, Bool, ModDetails, CgGuts) -hscNormalIface hsc_env simpl_result mb_old_iface = - runHsc hsc_env $ hscNormalIface' simpl_result mb_old_iface +hscNormalIface hsc_env extCore_filename simpl_result mb_old_iface = + runHsc hsc_env $ hscNormalIface' extCore_filename simpl_result mb_old_iface -hscNormalIface' :: ModGuts +hscNormalIface' :: FilePath + -> ModGuts -> Maybe Fingerprint -> Hsc (ModIface, Bool, ModDetails, CgGuts) -hscNormalIface' simpl_result mb_old_iface = do +hscNormalIface' extCore_filename simpl_result mb_old_iface = do hsc_env <- getHscEnv (cg_guts, details) <- {-# SCC "CoreTidy" #-} liftIO $ tidyProgram hsc_env simpl_result @@ -1110,7 +1113,7 @@ hscNormalIface' simpl_result mb_old_iface = do -- This should definitely be here and not after CorePrep, -- because CorePrep produces unqualified constructor wrapper declarations, -- so its output isn't valid External Core (without some preprocessing). - liftIO $ emitExternalCore (hsc_dflags hsc_env) cg_guts + liftIO $ emitExternalCore (hsc_dflags hsc_env) extCore_filename cg_guts liftIO $ dumpIfaceStats hsc_env -- Return the prepared code. @@ -1132,13 +1135,13 @@ hscWriteIface dflags iface no_change mod_summary = do -- TODO: Should handle the dynamic hi filename properly let dynIfaceFile = replaceExtension ifaceFile (dynHiSuf dflags) dynIfaceFile' = addBootSuffix_maybe (mi_boot iface) dynIfaceFile - dynDflags = doDynamicToo dflags + dynDflags = dynamicTooMkDynamicDynFlags dflags writeIfaceFile dynDflags dynIfaceFile' iface -- | Compile to hard-code. -hscGenHardCode :: HscEnv -> CgGuts -> ModSummary +hscGenHardCode :: HscEnv -> CgGuts -> ModSummary -> FilePath -> IO (FilePath, Maybe FilePath) -- ^ @Just f@ <=> _stub.c is f -hscGenHardCode hsc_env cgguts mod_summary = do +hscGenHardCode hsc_env cgguts mod_summary 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, @@ -1184,8 +1187,8 @@ hscGenHardCode hsc_env cgguts mod_summary = do (output_filename, (_stub_h_exists, stub_c_exists)) <- {-# SCC "codeOutput" #-} - codeOutput dflags this_mod location foreign_stubs - dependencies rawcmms1 + codeOutput dflags this_mod output_filename location + foreign_stubs dependencies rawcmms1 return (output_filename, stub_c_exists) @@ -1226,8 +1229,8 @@ hscInteractive _ _ = panic "GHC not compiled with interpreter" ------------------------------ -hscCompileCmmFile :: HscEnv -> FilePath -> IO () -hscCompileCmmFile hsc_env filename = runHsc hsc_env $ do +hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> IO () +hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do let dflags = hsc_dflags hsc_env cmm <- ioMsgMaybe $ parseCmmFile dflags filename liftIO $ do @@ -1236,7 +1239,7 @@ hscCompileCmmFile hsc_env filename = runHsc hsc_env $ do dumpIfSet_dyn dflags Opt_D_dump_cmm "Parsed Cmm" (ppr cmm) (_, cmmgroup) <- cmmPipeline hsc_env initTopSRT cmm rawCmms <- cmmToRawCmm dflags (Stream.yield cmmgroup) - _ <- codeOutput dflags no_mod no_loc NoStubs [] rawCmms + _ <- codeOutput dflags no_mod output_filename no_loc NoStubs [] rawCmms return () where no_mod = panic "hscCmmFile: no_mod" @@ -1321,7 +1324,7 @@ myCoreToStg :: DynFlags -> Module -> CoreProgram myCoreToStg dflags this_mod prepd_binds = do stg_binds <- {-# SCC "Core2Stg" #-} - coreToStg dflags prepd_binds + coreToStg dflags this_mod prepd_binds (stg_binds2, cost_centre_info) <- {-# SCC "Stg2Stg" #-} @@ -1556,13 +1559,13 @@ hscParseThingWithLocation source linenumber parser str return thing hscCompileCore :: HscEnv -> Bool -> SafeHaskellMode -> ModSummary - -> CoreProgram -> IO () -hscCompileCore hsc_env simplify safe_mode mod_summary binds + -> CoreProgram -> FilePath -> FilePath -> IO () +hscCompileCore hsc_env simplify safe_mode mod_summary binds output_filename extCore_filename = runHsc hsc_env $ do guts <- maybe_simplify (mkModGuts (ms_mod mod_summary) safe_mode binds) - (iface, changed, _details, cgguts) <- hscNormalIface' guts Nothing + (iface, changed, _details, cgguts) <- hscNormalIface' extCore_filename guts Nothing liftIO $ hscWriteIface (hsc_dflags hsc_env) iface changed mod_summary - _ <- liftIO $ hscGenHardCode hsc_env cgguts mod_summary + _ <- liftIO $ hscGenHardCode hsc_env cgguts mod_summary output_filename return () where |