- 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 ...
-
- pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
-
- where
- outputFileName last_phase keep suffix
- = do o_file <- readIORef v_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 odir_ify (orig_basename ++ '.':suffix)
- else newTempName suffix
+ -- 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 <- pipeLoop start_phase stop_phase input_fn basename suffix
+ get_output_fn
+
+ -- 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
+ 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 -> IO FilePath) -> IO FilePath
+
+pipeLoop phase stop_phase input_fn orig_basename orig_suff get_output_fn
+ | phase == stop_phase = return input_fn -- 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
+ case maybe_next_phase of
+ (Nothing, output_fn) ->
+ -- we stopped early, but return the *final* filename
+ -- (it presumably already exists)
+ get_output_fn stop_phase
+ (Just next_phase, output_fn) ->
+ pipeLoop next_phase stop_phase output_fn
+ orig_basename orig_suff get_output_fn
+
+
+genOutputFilenameFunc :: Bool -> Maybe FilePath -> Phase -> String
+ -> IO (Phase{-next phase-} -> IO FilePath)
+genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename
+ = do
+ hcsuf <- readIORef v_HC_suf
+ 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
+ | next_phase == stop_phase
+ = case maybe_output_filename of
+ Just file -> return file
+ Nothing | keep_output -> return persistent
+ | otherwise -> newTempName suffix
+ -- sometimes, we keep output from intermediate stages
+ | otherwise
+ = case next_phase of
+ Ln -> return 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
+
+ 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 -> IO FilePath) -- how to calculate the output filename
+ -> IO (Maybe Phase, -- next phase
+ FilePath) -- output filename