-
- output_fn <- outputFileName (null phases) keep o_suffix
-
- carry_on <- run_phase phase orig_basename orig_suffix input_fn output_fn
- -- sometimes we bail out early, eg. when the compiler's recompilation
- -- checker has determined that recompilation isn't necessary.
- if not carry_on
- then do let (_,keep,final_suffix) = last phases
- ofile <- outputFileName True keep final_suffix
- return ofile
- else do -- carry on ...
-
- -- sadly, ghc -E is supposed to write the file to stdout. We
- -- generate <file>.cpp, so we also have to cat the file here.
- when (null phases && phase == Cpp) $
- run_something "Dump pre-processed file to stdout"
- ("cat " ++ output_fn)
-
- pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
-
- where
- outputFileName last_phase keep suffix
- = do o_file <- readIORef output_file
- if last_phase && not do_linking && use_ofile && isJust o_file
- then case o_file of
- Just s -> return s
- Nothing -> error "outputFileName"
- else if keep == Persistent
- then do f <- odir_ify (orig_basename ++ '.':suffix)
- osuf_ify f
- else newTempName suffix
+ split <- readIORef v_Split_object_files
+ let (basename, suffix) = splitFilename input_fn
+ start_phase = startPhase suffix
+
+ 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