Commit 68833e5e authored by ian@well-typed.com's avatar ian@well-typed.com

Make "happensBefore" take account of whether we are unregisterised

If we are not unregisterised then we skip the HCc phase.
Fixes #7563.
parent 385dced6
......@@ -35,6 +35,7 @@ module DriverPhases (
#include "HsVersions.h"
import {-# SOURCE #-} DynFlags
import Outputable
import Platform
import System.FilePath
......@@ -131,33 +132,39 @@ eqPhase _ _ = False
-- Partial ordering on phases: we want to know which phases will occur before
-- which others. This is used for sanity checking, to ensure that the
-- pipeline will stop at some point (see DriverPipeline.runPipeline).
happensBefore :: Phase -> Phase -> Bool
StopLn `happensBefore` _ = False
x `happensBefore` y = after_x `eqPhase` y || after_x `happensBefore` y
where
after_x = nextPhase x
happensBefore :: DynFlags -> Phase -> Phase -> Bool
happensBefore dflags p1 p2 = p1 `happensBefore'` p2
where StopLn `happensBefore'` _ = False
x `happensBefore'` y = after_x `eqPhase` y
|| after_x `happensBefore'` y
where after_x = nextPhase dflags x
nextPhase :: Phase -> Phase
-- A conservative approximation to the next phase, used in happensBefore
nextPhase (Unlit sf) = Cpp sf
nextPhase (Cpp sf) = HsPp sf
nextPhase (HsPp sf) = Hsc sf
nextPhase (Hsc _) = HCc
nextPhase Splitter = SplitAs
nextPhase LlvmOpt = LlvmLlc
nextPhase LlvmLlc = LlvmMangle
nextPhase LlvmMangle = As
nextPhase SplitAs = MergeStub
nextPhase As = MergeStub
nextPhase Ccpp = As
nextPhase Cc = As
nextPhase Cobjc = As
nextPhase Cobjcpp = As
nextPhase CmmCpp = Cmm
nextPhase Cmm = HCc
nextPhase HCc = As
nextPhase MergeStub = StopLn
nextPhase StopLn = panic "nextPhase: nothing after StopLn"
nextPhase :: DynFlags -> Phase -> Phase
nextPhase dflags p
-- A conservative approximation to the next phase, used in happensBefore
= case p of
Unlit sf -> Cpp sf
Cpp sf -> HsPp sf
HsPp sf -> Hsc sf
Hsc _ -> maybeHCc
Splitter -> SplitAs
LlvmOpt -> LlvmLlc
LlvmLlc -> LlvmMangle
LlvmMangle -> As
SplitAs -> MergeStub
As -> MergeStub
Ccpp -> As
Cc -> As
Cobjc -> As
Cobjcpp -> As
CmmCpp -> Cmm
Cmm -> maybeHCc
HCc -> As
MergeStub -> StopLn
StopLn -> panic "nextPhase: nothing after StopLn"
where maybeHCc = if platformUnregisterised (targetPlatform dflags)
then HCc
else As
-- the first compilation phase for a given file is determined
-- by its suffix.
......
......@@ -540,7 +540,8 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
-- There is a partial ordering on phases, where A < B iff A occurs
-- before B in a normal compilation pipeline.
when (not (start_phase `happensBefore` stop_phase)) $
let happensBefore' = happensBefore dflags
when (not (start_phase `happensBefore'` stop_phase)) $
throwGhcException (UsageError
("cannot compile this file to desired target: "
++ input_fn))
......@@ -682,12 +683,13 @@ phaseOutputFilename next_phase = do
pipeLoop :: Phase -> FilePath -> CompPipeline FilePath
pipeLoop phase input_fn = do
PipeEnv{stop_phase} <- getPipeEnv
PipeState{hsc_env} <- getPipeState
dflags <- getDynFlags
let happensBefore' = happensBefore dflags
case () of
_ | phase `eqPhase` stop_phase -- All done
-> return input_fn
| not (phase `happensBefore` stop_phase)
| not (phase `happensBefore'` stop_phase)
-- Something has gone wrong. We'll try to cover all the cases when
-- this could happen, so if we reach here it is a panic.
-- eg. it might happen if the -C flag is used on a source file that
......@@ -696,9 +698,8 @@ pipeLoop phase input_fn = do
" but I wanted to stop at phase " ++ show stop_phase)
| otherwise
-> do liftIO $ debugTraceMsg (hsc_dflags hsc_env) 4
-> do liftIO $ debugTraceMsg dflags 4
(ptext (sLit "Running phase") <+> ppr phase)
dflags <- getDynFlags
(next_phase, output_fn) <- runPhase phase input_fn dflags
pipeLoop next_phase output_fn
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment