+ stop_phase = case todo of
+ StopBefore As | split -> SplitAs
+ StopBefore phase -> phase
+ DoMkDependHS -> Ln
+ DoLink -> Ln
+ DoMkDLL -> Ln
+
+ -- We want to catch cases of "you can't get there from here" before
+ -- we start the pipeline, because otherwise it will just run off the
+ -- end.
+ --
+ -- 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)) $
+ throwDyn (UsageError
+ ("flag `" ++ stop_flag
+ ++ "' is incompatible with source file `"
+ ++ input_fn ++ "'"))
+
+ -- generate a function which will be used to calculate output file names
+ -- as we go along.
+ get_output_fn <- genOutputFilenameFunc keep_output maybe_output_filename
+ stop_phase basename
+
+ -- and execute the pipeline...
+ (output_fn, maybe_loc) <-
+ pipeLoop start_phase stop_phase input_fn basename suffix
+ get_output_fn maybe_loc
+
+ -- sometimes, a compilation phase doesn't actually generate any output
+ -- (eg. the CPP phase when -fcpp is not turned on). If we end on this
+ -- stage, but we wanted to keep the output, then we have to explicitly
+ -- copy the file.
+ if keep_output
+ then do final_fn <- get_output_fn stop_phase maybe_loc
+ when (final_fn /= output_fn) $
+ copy ("Copying `" ++ output_fn ++ "' to `" ++ final_fn
+ ++ "'") output_fn final_fn
+ return final_fn
+ else
+ return output_fn
+
+
+pipeLoop :: Phase -> Phase -> FilePath -> String -> Suffix
+ -> (Phase -> Maybe ModLocation -> IO FilePath)
+ -> Maybe ModLocation -> IO (FilePath, Maybe ModLocation)
+
+pipeLoop phase stop_phase input_fn orig_basename orig_suff
+ get_output_fn maybe_loc
+
+ | phase == stop_phase = return (input_fn, maybe_loc) -- all done
+
+ | 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
+ -- has {-# OPTIONS -fasm #-}.
+ panic ("pipeLoop: at phase " ++ show phase ++
+ " but I wanted to stop at phase " ++ show stop_phase)
+
+ | otherwise = do
+ maybe_next_phase <- runPhase phase orig_basename orig_suff input_fn
+ get_output_fn maybe_loc
+ case maybe_next_phase of
+ (Nothing, maybe_loc, output_fn) -> do
+ -- we stopped early, but return the *final* filename
+ -- (it presumably already exists)
+ final_fn <- get_output_fn stop_phase maybe_loc
+ return (final_fn, maybe_loc)
+ (Just next_phase, maybe_loc, output_fn) ->
+ pipeLoop next_phase stop_phase output_fn
+ orig_basename orig_suff get_output_fn maybe_loc
+
+
+genOutputFilenameFunc :: Bool -> Maybe FilePath -> Phase -> String
+ -> IO (Phase{-next phase-} -> Maybe ModLocation -> IO FilePath)
+genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename
+ = do
+ hcsuf <- readIORef v_HC_suf
+ odir <- readIORef v_Output_dir
+ osuf <- readIORef v_Object_suf
+ keep_hc <- readIORef v_Keep_hc_files
+#ifdef ILX
+ keep_il <- readIORef v_Keep_il_files
+ keep_ilx <- readIORef v_Keep_ilx_files
+#endif
+ keep_raw_s <- readIORef v_Keep_raw_s_files
+ keep_s <- readIORef v_Keep_s_files
+ let
+ myPhaseInputExt HCc | Just s <- hcsuf = s
+ myPhaseInputExt Ln = osuf
+ myPhaseInputExt other = phaseInputExt other
+
+ func next_phase maybe_location
+ | next_phase == stop_phase
+ = case maybe_output_filename of
+ Just file -> return file
+ Nothing
+ | Ln <- next_phase -> return odir_persistent
+ | keep_output -> return persistent
+ | otherwise -> newTempName suffix
+ -- sometimes, we keep output from intermediate stages
+ | otherwise
+ = case next_phase of
+ Ln -> return odir_persistent
+ Mangle | keep_raw_s -> return persistent
+ As | keep_s -> return persistent
+ HCc | keep_hc -> return persistent
+ _other -> newTempName suffix
+ where
+ suffix = myPhaseInputExt next_phase
+ persistent = basename ++ '.':suffix
+
+ odir_persistent
+ | Just loc <- maybe_location = ml_obj_file loc
+ | Just d <- odir = replaceFilenameDirectory persistent d
+ | otherwise = persistent
+
+ return func
+
+
+-- -----------------------------------------------------------------------------
+-- Each phase in the pipeline returns the next phase to execute, and the
+-- name of the file in which the output was placed.
+--
+-- We must do things dynamically this way, because we often don't know
+-- what the rest of the phases will be until part-way through the
+-- compilation: for example, an {-# OPTIONS -fasm #-} at the beginning
+-- of a source file can change the latter stages of the pipeline from
+-- taking the via-C route to using the native code generator.
+
+runPhase :: Phase
+ -> String -- basename of original input source
+ -> String -- its extension
+ -> FilePath -- name of file which contains the input to this phase.
+ -> (Phase -> Maybe ModLocation -> IO FilePath)
+ -- how to calculate the output filename
+ -> Maybe ModLocation -- the ModLocation, if we have one
+ -> IO (Maybe Phase, -- next phase
+ Maybe ModLocation, -- the ModLocation, if we have one
+ FilePath) -- output filename