diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index d6c096a59563..ce25727703af 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -45,6 +45,7 @@ import System.IO \begin{code} codeOutput :: DynFlags -> Module + -> FilePath -> ModLocation -> ForeignStubs -> [PackageId] @@ -52,7 +53,7 @@ codeOutput :: DynFlags -> IO (FilePath, (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-})) -codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream +codeOutput dflags this_mod filenm location foreign_stubs pkg_deps cmm_stream = do { -- Lint each CmmGroup as it goes past @@ -72,7 +73,6 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream } ; showPass dflags "CodeOutput" - ; let filenm = hscOutName dflags ; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs ; case hscTarget dflags of { HscAsm -> outputAsm dflags filenm linted_cmm_stream; diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 840a0470e275..de717b05d4b1 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -148,8 +148,7 @@ compileOne' m_tc_result mHscMessage output_fn <- getOutputFilename next_phase Temporary basename dflags next_phase (Just location) - let dflags' = dflags { hscOutName = output_fn, - extCoreName = basename ++ ".hcr" } + let dflags' = dflags { extCoreName = basename ++ ".hcr" } let hsc_env' = hsc_env { hsc_dflags = dflags' } -- -fforce-recomp should also work with --make @@ -1039,11 +1038,9 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do HscRecomp cgguts mod_summary -> do output_fn <- phaseOutputFilename next_phase - let dflags' = dflags { hscOutName = output_fn } - setDynFlags dflags' PipeState{hsc_env=hsc_env'} <- getPipeState - (outputFilename, mStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary + (outputFilename, mStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary output_fn case mStub of Nothing -> return () Just stub_c -> @@ -1071,13 +1068,12 @@ runPhase (RealPhase Cmm) input_fn dflags output_fn <- phaseOutputFilename next_phase - let dflags' = dflags { hscOutName = output_fn, - extCoreName = src_basename ++ ".hcr" } + let dflags' = dflags { extCoreName = src_basename ++ ".hcr" } setDynFlags dflags' PipeState{hsc_env} <- getPipeState - liftIO $ hscCompileCmmFile hsc_env input_fn + liftIO $ hscCompileCmmFile hsc_env input_fn output_fn return (RealPhase next_phase, output_fn) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 2fbb0105e5eb..5a0f6f9f2bbc 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -560,7 +560,6 @@ data DynFlags = DynFlags { ghcLink :: GhcLink, hscTarget :: HscTarget, settings :: Settings, - hscOutName :: String, -- ^ Name of the output file extCoreName :: String, -- ^ Name of the .hcr output file verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] optLevel :: Int, -- ^ Optimisation level @@ -1213,7 +1212,6 @@ defaultDynFlags mySettings = ghcMode = CompManager, ghcLink = LinkBinary, hscTarget = defaultHscTarget (sTargetPlatform mySettings), - hscOutName = "", extCoreName = "", verbosity = 0, optLevel = 0, diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index c72f1f1be69c..3e5fe9cea973 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -892,8 +892,8 @@ compileToCoreSimplified = compileCore True -- The resulting .o, .hi, and executable files, if any, are stored in the -- current directory, and named according to the module name. -- This has only so far been tested with a single self-contained module. -compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m () -compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do +compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> FilePath -> m () +compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) output_fn = do dflags <- getSessionDynFlags currentTime <- liftIO $ getCurrentTime cwd <- liftIO $ getCurrentDirectory @@ -919,7 +919,7 @@ compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do } hsc_env <- getSession - liftIO $ hscCompileCore hsc_env simplify (cm_safe cm) modSum (cm_binds cm) + liftIO $ hscCompileCore hsc_env simplify (cm_safe cm) modSum (cm_binds cm) output_fn compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index c97e3ec724d1..a6d45081c32d 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -1136,9 +1136,9 @@ hscWriteIface dflags iface no_change mod_summary = do 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 +1184,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 +1226,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 +1236,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" @@ -1556,13 +1556,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 -> IO () +hscCompileCore hsc_env simplify safe_mode mod_summary binds output_filename = runHsc hsc_env $ do guts <- maybe_simplify (mkModGuts (ms_mod mod_summary) safe_mode binds) (iface, changed, _details, cgguts) <- hscNormalIface' 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 diff --git a/ghc/Main.hs b/ghc/Main.hs index 35dbf5bf2a8c..629529271ca6 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -159,8 +159,6 @@ main' postLoadMode dflags0 args flagWarnings = do dflags2 = dflags1{ ghcMode = mode, hscTarget = lang, ghcLink = link, - -- leave out hscOutName for now - hscOutName = panic "Main.main:hscOutName not set", verbosity = case postLoadMode of DoEval _ -> 0 _other -> 1