diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2022-07-18 14:48:11 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-07-19 10:07:53 -0400 |
commit | e8c07aa91f0f05816b455457e3781c247b7399ca (patch) | |
tree | 59d0c9c56fd1d54cea9846e0f584b8fc6cec28ec /compiler | |
parent | bd92182cd56140ffb2f68ec01492e5aa6333a8fc (diff) | |
download | haskell-e8c07aa91f0f05816b455457e3781c247b7399ca.tar.gz |
driver: Fix implementation of -S
We were failing to stop before running the assembler so the object file
was also created.
Fixes #21869
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 31 |
1 files changed, 17 insertions, 14 deletions
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index e988979df2..0149bf644f 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -579,7 +579,7 @@ compileForeign hsc_env lang stub_c = do LangCxx -> viaCPipeline Ccxx LangObjc -> viaCPipeline Cobjc LangObjcxx -> viaCPipeline Cobjcxx - LangAsm -> \pe hsc_env ml fp -> Just <$> asPipeline True pe hsc_env ml fp + LangAsm -> \pe hsc_env ml fp -> asPipeline True pe hsc_env ml fp #if __GLASGOW_HASKELL__ < 811 RawObject -> panic "compileForeign: should be unreachable" #endif @@ -587,6 +587,7 @@ compileForeign hsc_env lang stub_c = do res <- runPipeline (hsc_hooks hsc_env) (pipeline pipe_env hsc_env Nothing stub_c) case res of -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`. + -- and the same should never happen for asPipeline -- Future refactoring to not check StopC for this case Nothing -> pprPanic "compileForeign" (ppr stub_c) Just fp -> return fp @@ -765,28 +766,30 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do return (Just linkable) return (miface, final_linkable) -asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m ObjFile -asPipeline use_cpp pipe_env hsc_env location input_fn = do - use (T_As use_cpp pipe_env hsc_env location input_fn) +asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile) +asPipeline use_cpp pipe_env hsc_env location input_fn = + case stop_phase pipe_env of + StopAs -> return Nothing + _ -> Just <$> use (T_As use_cpp pipe_env hsc_env location input_fn) viaCPipeline :: P m => Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) viaCPipeline c_phase pipe_env hsc_env location input_fn = do out_fn <- use (T_Cc c_phase pipe_env hsc_env input_fn) case stop_phase pipe_env of StopC -> return Nothing - _ -> Just <$> asPipeline False pipe_env hsc_env location out_fn + _ -> asPipeline False pipe_env hsc_env location out_fn -llvmPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath +llvmPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) llvmPipeline pipe_env hsc_env location fp = do opt_fn <- use (T_LlvmOpt pipe_env hsc_env fp) llvmLlcPipeline pipe_env hsc_env location opt_fn -llvmLlcPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath +llvmLlcPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) llvmLlcPipeline pipe_env hsc_env location opt_fn = do llc_fn <- use (T_LlvmLlc pipe_env hsc_env opt_fn) llvmManglePipeline pipe_env hsc_env location llc_fn -llvmManglePipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath +llvmManglePipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) llvmManglePipeline pipe_env hsc_env location llc_fn = do mangled_fn <- if gopt Opt_NoLlvmMangler (hsc_dflags hsc_env) @@ -818,10 +821,10 @@ applyPostHscPipeline => DefunctionalizedPostHscPipeline -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) applyPostHscPipeline NcgPostHscPipeline = - \pe he ml fp -> Just <$> asPipeline False pe he ml fp + \pe he ml fp -> asPipeline False pe he ml fp applyPostHscPipeline ViaCPostHscPipeline = viaCPipeline HCc applyPostHscPipeline LlvmPostHscPipeline = - \pe he ml fp -> Just <$> llvmPipeline pe he ml fp + \pe he ml fp -> llvmPipeline pe he ml fp applyPostHscPipeline NoPostHscPipeline = \_ _ _ _ -> return Nothing @@ -854,7 +857,7 @@ pipelineStart pipe_env hsc_env input_fn = c :: P m => Phase -> m (Maybe FilePath) c phase = viaCPipeline phase pipe_env hsc_env Nothing input_fn as :: P m => Bool -> m (Maybe FilePath) - as use_cpp = Just <$> asPipeline use_cpp pipe_env hsc_env Nothing input_fn + as use_cpp = asPipeline use_cpp pipe_env hsc_env Nothing input_fn objFromLinkable (_, Just (LM _ _ [DotO lnk])) = Just lnk objFromLinkable _ = Nothing @@ -880,9 +883,9 @@ pipelineStart pipe_env hsc_env input_fn = fromSuffix "cxx" = c Ccxx fromSuffix "s" = as False fromSuffix "S" = as True - fromSuffix "ll" = Just <$> llvmPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "bc" = Just <$> llvmLlcPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "lm_s" = Just <$> llvmManglePipeline pipe_env hsc_env Nothing input_fn + fromSuffix "ll" = llvmPipeline pipe_env hsc_env Nothing input_fn + fromSuffix "bc" = llvmLlcPipeline pipe_env hsc_env Nothing input_fn + fromSuffix "lm_s" = llvmManglePipeline pipe_env hsc_env Nothing input_fn fromSuffix "o" = return (Just input_fn) fromSuffix "cmm" = Just <$> cmmCppPipeline pipe_env hsc_env input_fn fromSuffix "cmmcpp" = Just <$> cmmPipeline pipe_env hsc_env input_fn |