compiler/main/DriverPipeline.hs

   1 {-# OPTIONS -fno-cse #-}
   2 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
   3
   4 -----------------------------------------------------------------------------
   5 --
   6 -- GHC Driver
   7 --
   8 -- (c) The University of Glasgow 2005
   9 --
  10 -----------------------------------------------------------------------------
  11
  12 module DriverPipeline (
  13         -- Run a series of compilation steps in a pipeline, for a
  14         -- collection of source files.
  15    oneShot, compileFile,
  16
  17         -- Interfaces for the batch-mode driver
  18    linkBinary,
  19
  20         -- Interfaces for the compilation manager (interpreted/batch-mode)
  21    preprocess,
  22    compile,
  23    link,
  24
  25   ) where
  26
  27 #include "HsVersions.h"
  28
  29 import Packages
  30 import HeaderInfo
  31 import DriverPhases
  32 import SysTools
  33 import HscMain
  34 import Finder
  35 import HscTypes
  36 import Outputable
  37 import Module
  38 import LazyUniqFM               ( eltsUFM )
  39 import ErrUtils
  40 import DynFlags
  41 import StaticFlags      ( v_Ld_inputs, opt_Static, WayName(..) )
  42 import Config
  43 import Panic
  44 import Util
  45 import StringBuffer     ( hGetStringBuffer )
  46 import BasicTypes       ( SuccessFlag(..) )
  47 import Maybes           ( expectJust )
  48 import ParserCoreUtils  ( getCoreModuleName )
  49 import SrcLoc
  50 import FastString
  51 import MonadUtils
  52
  53 import Data.Either
  54 import Exception
  55 import Data.IORef       ( readIORef, writeIORef, IORef )
  56 import GHC.Exts         ( Int(..) )
  57 import System.Directory
  58 import System.FilePath
  59 import System.IO
  60 import System.IO.Error as IO
  61 import Control.Monad
  62 import Data.List        ( isSuffixOf )
  63 import Data.Maybe
  64 import System.Environment
  65
  66 -- ---------------------------------------------------------------------------
  67 -- Pre-process
  68
  69 -- | Just preprocess a file, put the result in a temp. file (used by the
  70 -- compilation manager during the summary phase).
  71 --
  72 -- We return the augmented DynFlags, because they contain the result
  73 -- of slurping in the OPTIONS pragmas
  74
  75 preprocess :: GhcMonad m =>
  76               HscEnv
  77            -> (FilePath, Maybe Phase) -- ^ filename and starting phase
  78            -> m (DynFlags, FilePath)
  79 preprocess hsc_env (filename, mb_phase) =
  80   ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename)
  81   runPipeline anyHsc hsc_env (filename, mb_phase)
  82         Nothing Temporary Nothing{-no ModLocation-}
  83
  84 -- ---------------------------------------------------------------------------
  85
  86 -- | Compile
  87 --
  88 -- Compile a single module, under the control of the compilation manager.
  89 --
  90 -- This is the interface between the compilation manager and the
  91 -- compiler proper (hsc), where we deal with tedious details like
  92 -- reading the OPTIONS pragma from the source file, and passing the
  93 -- output of hsc through the C compiler.
  94 --
  95 -- NB.  No old interface can also mean that the source has changed.
  96
  97 compile :: GhcMonad m =>
  98            HscEnv
  99         -> ModSummary      -- ^ summary for module being compiled
 100         -> Int             -- ^ module N ...
 101         -> Int             -- ^ ... of M
 102         -> Maybe ModIface  -- ^ old interface, if we have one
 103         -> Maybe Linkable  -- ^ old linkable, if we have one
 104         -> m HomeModInfo   -- ^ the complete HomeModInfo, if successful
 105
 106 compile hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
 107  = do
 108    let dflags0     = ms_hspp_opts summary
 109        this_mod    = ms_mod summary
 110        src_flavour = ms_hsc_src summary
 111        location    = ms_location summary
 112        input_fn    = expectJust "compile:hs" (ml_hs_file location)
 113        input_fnpp  = ms_hspp_file summary
 114
 115    liftIO $ debugTraceMsg dflags0 2 (text "compile: input file" <+> text input_fnpp)
 116
 117    let basename = dropExtension input_fn
 118
 119   -- We add the directory in which the .hs files resides) to the import path.
 120   -- This is needed when we try to compile the .hc file later, if it
 121   -- imports a _stub.h file that we created here.
 122    let current_dir = case takeDirectory basename of
 123                      "" -> "." -- XXX Hack
 124                      d -> d
 125        old_paths   = includePaths dflags0
 126        dflags      = dflags0 { includePaths = current_dir : old_paths }
 127        hsc_env     = hsc_env0 {hsc_dflags = dflags}
 128
 129    -- Figure out what lang we're generating
 130    let hsc_lang = hscMaybeAdjustTarget dflags StopLn src_flavour (hscTarget dflags)
 131    -- ... and what the next phase should be
 132    let next_phase = hscNextPhase dflags src_flavour hsc_lang
 133    -- ... and what file to generate the output into
 134    output_fn <- liftIO $ getOutputFilename next_phase
 135                         Temporary basename dflags next_phase (Just location)
 136
 137    let dflags' = dflags { hscTarget = hsc_lang,
 138                                 hscOutName = output_fn,
 139                                 extCoreName = basename ++ ".hcr" }
 140    let hsc_env' = hsc_env { hsc_dflags = dflags' }
 141
 142    -- -fforce-recomp should also work with --make
 143    let force_recomp = dopt Opt_ForceRecomp dflags
 144        source_unchanged = isJust maybe_old_linkable && not force_recomp
 145        object_filename = ml_obj_file location
 146
 147    let getStubLinkable False = return []
 148        getStubLinkable True
 149            = do stub_o <- compileStub hsc_env' this_mod location
 150                 return [ DotO stub_o ]
 151
 152        handleBatch HscNoRecomp
 153            = ASSERT (isJust maybe_old_linkable)
 154              return maybe_old_linkable
 155
 156        handleBatch (HscRecomp hasStub)
 157            | isHsBoot src_flavour
 158                = do when (isObjectTarget hsc_lang) $ -- interpreted reaches here too
 159                        liftIO $ SysTools.touch dflags' "Touching object file"
 160                                    object_filename
 161                     return maybe_old_linkable
 162
 163            | otherwise
 164                = do stub_unlinked <- getStubLinkable hasStub
 165                     (hs_unlinked, unlinked_time) <-
 166                         case hsc_lang of
 167                           HscNothing
 168                             -> return ([], ms_hs_date summary)
 169                           -- We're in --make mode: finish the compilation pipeline.
 170                           _other
 171                             -> do runPipeline StopLn hsc_env' (output_fn,Nothing)
 172                                               (Just basename)
 173                                               Persistent
 174                                               (Just location)
 175                                   -- The object filename comes from the ModLocation
 176                                   o_time <- liftIO $ getModificationTime object_filename
 177                                   return ([DotO object_filename], o_time)
 178                     let linkable = LM unlinked_time this_mod
 179                                    (hs_unlinked ++ stub_unlinked)
 180                     return (Just linkable)
 181
 182        handleInterpreted InteractiveNoRecomp
 183            = ASSERT (isJust maybe_old_linkable)
 184              return maybe_old_linkable
 185        handleInterpreted (InteractiveRecomp hasStub comp_bc modBreaks)
 186            = do stub_unlinked <- getStubLinkable hasStub
 187                 let hs_unlinked = [BCOs comp_bc modBreaks]
 188                     unlinked_time = ms_hs_date summary
 189                   -- Why do we use the timestamp of the source file here,
 190                   -- rather than the current time?  This works better in
 191                   -- the case where the local clock is out of sync
 192                   -- with the filesystem's clock.  It's just as accurate:
 193                   -- if the source is modified, then the linkable will
 194                   -- be out of date.
 195                 let linkable = LM unlinked_time this_mod
 196                                (hs_unlinked ++ stub_unlinked)
 197                 return (Just linkable)
 198
 199    let -- runCompiler :: Compiler result -> (result -> Maybe Linkable)
 200        --            -> m HomeModInfo
 201        runCompiler compiler handle
 202            = do (result, iface, details)
 203                     <- compiler hsc_env' summary source_unchanged mb_old_iface
 204                                 (Just (mod_index, nmods))
 205                 linkable <- handle result
 206                 return (HomeModInfo{ hm_details  = details,
 207                                      hm_iface    = iface,
 208                                      hm_linkable = linkable })
 209    -- run the compiler
 210    case hsc_lang of
 211       HscInterpreted
 212         | isHsBoot src_flavour ->
 213                 runCompiler hscCompileNothing handleBatch
 214         | otherwise ->
 215                 runCompiler hscCompileInteractive handleInterpreted
 216       HscNothing ->
 217                 runCompiler hscCompileNothing handleBatch
 218       _other ->
 219                 runCompiler hscCompileBatch handleBatch
 220
 221 -----------------------------------------------------------------------------
 222 -- stub .h and .c files (for foreign export support)
 223
 224 -- The _stub.c file is derived from the haskell source file, possibly taking
 225 -- into account the -stubdir option.
 226 --
 227 -- Consequently, we derive the _stub.o filename from the haskell object
 228 -- filename.
 229 --
 230 -- This isn't necessarily the same as the object filename we
 231 -- would get if we just compiled the _stub.c file using the pipeline.
 232 -- For example:
 233 --
 234 --    ghc src/A.hs -odir obj
 235 --
 236 -- results in obj/A.o, and src/A_stub.c.  If we compile src/A_stub.c with
 237 -- -odir obj, we would get obj/src/A_stub.o, which is wrong; we want
 238 -- obj/A_stub.o.
 239
 240 compileStub :: GhcMonad m => HscEnv -> Module -> ModLocation
 241             -> m FilePath
 242 compileStub hsc_env mod location = do
 243         let (o_base, o_ext) = splitExtension (ml_obj_file location)
 244             stub_o = (o_base ++ "_stub") <.> o_ext
 245
 246         -- compile the _stub.c file w/ gcc
 247         let (stub_c,_,_) = mkStubPaths (hsc_dflags hsc_env) (moduleName mod) location
 248         runPipeline StopLn hsc_env (stub_c,Nothing)  Nothing
 249                 (SpecificFile stub_o) Nothing{-no ModLocation-}
 250
 251         return stub_o
 252
 253
 254 -- ---------------------------------------------------------------------------
 255 -- Link
 256
 257 link :: GhcLink                 -- interactive or batch
 258      -> DynFlags                -- dynamic flags
 259      -> Bool                    -- attempt linking in batch mode?
 260      -> HomePackageTable        -- what to link
 261      -> IO SuccessFlag
 262
 263 -- For the moment, in the batch linker, we don't bother to tell doLink
 264 -- which packages to link -- it just tries all that are available.
 265 -- batch_attempt_linking should only be *looked at* in batch mode.  It
 266 -- should only be True if the upsweep was successful and someone
 267 -- exports main, i.e., we have good reason to believe that linking
 268 -- will succeed.
 269
 270 #ifdef GHCI
 271 link LinkInMemory _ _ _
 272     = do -- Not Linking...(demand linker will do the job)
 273          return Succeeded
 274 #endif
 275
 276 link NoLink _ _ _
 277    = return Succeeded
 278
 279 link LinkBinary dflags batch_attempt_linking hpt
 280    | batch_attempt_linking
 281    = do
 282         let
 283             home_mod_infos = eltsUFM hpt
 284
 285             -- the packages we depend on
 286             pkg_deps  = concatMap (dep_pkgs . mi_deps . hm_iface) home_mod_infos
 287
 288             -- the linkables to link
 289             linkables = map (expectJust "link".hm_linkable) home_mod_infos
 290
 291         debugTraceMsg dflags 3 (text "link: linkables are ..." $$ vcat (map ppr linkables))
 292
 293         -- check for the -no-link flag
 294         if isNoLink (ghcLink dflags)
 295           then do debugTraceMsg dflags 3 (text "link(batch): linking omitted (-c flag given).")
 296                   return Succeeded
 297           else do
 298
 299         let getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
 300             obj_files = concatMap getOfiles linkables
 301
 302             exe_file = exeFileName dflags
 303
 304         linking_needed <- linkingNeeded dflags linkables pkg_deps
 305
 306         if not (dopt Opt_ForceRecomp dflags) && not linking_needed
 307            then do debugTraceMsg dflags 2 (text exe_file <+> ptext (sLit "is up to date, linking not required."))
 308                    return Succeeded
 309            else do
 310
 311         debugTraceMsg dflags 1 (ptext (sLit "Linking") <+> text exe_file
 312                                  <+> text "...")
 313
 314         -- Don't showPass in Batch mode; doLink will do that for us.
 315         let link = case ghcLink dflags of
 316                 LinkBinary  -> linkBinary
 317                 LinkDynLib  -> linkDynLib
 318                 other       -> panicBadLink other
 319         link dflags obj_files pkg_deps
 320
 321         debugTraceMsg dflags 3 (text "link: done")
 322
 323         -- linkBinary only returns if it succeeds
 324         return Succeeded
 325
 326    | otherwise
 327    = do debugTraceMsg dflags 3 (text "link(batch): upsweep (partially) failed OR" $$
 328                                 text "   Main.main not exported; not linking.")
 329         return Succeeded
 330
 331 -- warning suppression
 332 link other _ _ _ = panicBadLink other
 333
 334 panicBadLink :: GhcLink -> a
 335 panicBadLink other = panic ("link: GHC not built to link this way: " ++
 336                             show other)
 337
 338
 339 linkingNeeded :: DynFlags -> [Linkable] -> [PackageId] -> IO Bool
 340 linkingNeeded dflags linkables pkg_deps = do
 341         -- if the modification time on the executable is later than the
 342         -- modification times on all of the objects and libraries, then omit
 343         -- linking (unless the -fforce-recomp flag was given).
 344   let exe_file = exeFileName dflags
 345   e_exe_time <- IO.try $ getModificationTime exe_file
 346   case e_exe_time of
 347     Left _  -> return True
 348     Right t -> do
 349         -- first check object files and extra_ld_inputs
 350         extra_ld_inputs <- readIORef v_Ld_inputs
 351         e_extra_times <- mapM (IO.try . getModificationTime) extra_ld_inputs
 352         let (errs,extra_times) = splitEithers e_extra_times
 353         let obj_times =  map linkableTime linkables ++ extra_times
 354         if not (null errs) || any (t <) obj_times
 355             then return True
 356             else do
 357
 358         -- next, check libraries. XXX this only checks Haskell libraries,
 359         -- not extra_libraries or -l things from the command line.
 360         let pkg_map = pkgIdMap (pkgState dflags)
 361             pkg_hslibs  = [ (libraryDirs c, lib)
 362                           | Just c <- map (lookupPackage pkg_map) pkg_deps,
 363                             lib <- packageHsLibs dflags c ]
 364
 365         pkg_libfiles <- mapM (uncurry findHSLib) pkg_hslibs
 366         if any isNothing pkg_libfiles then return True else do
 367         e_lib_times <- mapM (IO.try . getModificationTime)
 368                           (catMaybes pkg_libfiles)
 369         let (lib_errs,lib_times) = splitEithers e_lib_times
 370         if not (null lib_errs) || any (t <) lib_times
 371            then return True
 372            else return False
 373
 374 findHSLib :: [String] -> String -> IO (Maybe FilePath)
 375 findHSLib dirs lib = do
 376   let batch_lib_file = "lib" ++ lib <.> "a"
 377   found <- filterM doesFileExist (map (</> batch_lib_file) dirs)
 378   case found of
 379     [] -> return Nothing
 380     (x:_) -> return (Just x)
 381
 382 -- -----------------------------------------------------------------------------
 383 -- Compile files in one-shot mode.
 384
 385 oneShot :: GhcMonad m =>
 386            HscEnv -> Phase -> [(String, Maybe Phase)] -> m ()
 387 oneShot hsc_env stop_phase srcs = do
 388   o_files <- mapM (compileFile hsc_env stop_phase) srcs
 389   liftIO $ doLink (hsc_dflags hsc_env) stop_phase o_files
 390
 391 compileFile :: GhcMonad m =>
 392                HscEnv -> Phase -> (FilePath, Maybe Phase) -> m FilePath
 393 compileFile hsc_env stop_phase (src, mb_phase) = do
 394    exists <- liftIO $ doesFileExist src
 395    when (not exists) $
 396         ghcError (CmdLineError ("does not exist: " ++ src))
 397
 398    let
 399         dflags = hsc_dflags hsc_env
 400         split     = dopt Opt_SplitObjs dflags
 401         mb_o_file = outputFile dflags
 402         ghc_link  = ghcLink dflags      -- Set by -c or -no-link
 403
 404         -- When linking, the -o argument refers to the linker's output.
 405         -- otherwise, we use it as the name for the pipeline's output.
 406         output
 407          | StopLn <- stop_phase, not (isNoLink ghc_link) = Persistent
 408                 -- -o foo applies to linker
 409          | Just o_file <- mb_o_file = SpecificFile o_file
 410                 -- -o foo applies to the file we are compiling now
 411          | otherwise = Persistent
 412
 413         stop_phase' = case stop_phase of
 414                         As | split -> SplitAs
 415                         _          -> stop_phase
 416
 417    ( _, out_file) <- runPipeline stop_phase' hsc_env
 418                             (src, mb_phase) Nothing output
 419                             Nothing{-no ModLocation-}
 420    return out_file
 421
 422
 423 doLink :: DynFlags -> Phase -> [FilePath] -> IO ()
 424 doLink dflags stop_phase o_files
 425   | not (isStopLn stop_phase)
 426   = return ()           -- We stopped before the linking phase
 427
 428   | otherwise
 429   = case ghcLink dflags of
 430         NoLink     -> return ()
 431         LinkBinary -> linkBinary dflags o_files link_pkgs
 432         LinkDynLib -> linkDynLib dflags o_files []
 433         other      -> panicBadLink other
 434   where
 435    -- Always link in the haskell98 package for static linking.  Other
 436    -- packages have to be specified via the -package flag.
 437     link_pkgs
 438      | dopt Opt_AutoLinkPackages dflags = [haskell98PackageId]
 439      | otherwise                        = []
 440
 441
 442 -- ---------------------------------------------------------------------------
 443
 444 data PipelineOutput
 445   = Temporary
 446         -- ^ Output should be to a temporary file: we're going to
 447         -- run more compilation steps on this output later.
 448   | Persistent
 449         -- ^ We want a persistent file, i.e. a file in the current directory
 450         -- derived from the input filename, but with the appropriate extension.
 451         -- eg. in "ghc -c Foo.hs" the output goes into ./Foo.o.
 452   | SpecificFile FilePath
 453         -- ^ The output must go into the specified file.
 454
 455 -- | Run a compilation pipeline, consisting of multiple phases.
 456 --
 457 -- This is the interface to the compilation pipeline, which runs
 458 -- a series of compilation steps on a single source file, specifying
 459 -- at which stage to stop.
 460 --
 461 -- The DynFlags can be modified by phases in the pipeline (eg. by
 462 -- GHC_OPTIONS pragmas), and the changes affect later phases in the
 463 -- pipeline.
 464 runPipeline
 465   :: GhcMonad m =>
 466      Phase                      -- ^ When to stop
 467   -> HscEnv                     -- ^ Compilation environment
 468   -> (FilePath,Maybe Phase)     -- ^ Input filename (and maybe -x suffix)
 469   -> Maybe FilePath             -- ^ original basename (if different from ^^^)
 470   -> PipelineOutput             -- ^ Output filename
 471   -> Maybe ModLocation          -- ^ A ModLocation, if this is a Haskell module
 472   -> m (DynFlags, FilePath)     -- ^ (final flags, output filename)
 473
 474 runPipeline stop_phase hsc_env0 (input_fn, mb_phase) mb_basename output maybe_loc
 475   = do
 476   let dflags0 = hsc_dflags hsc_env0
 477       (input_basename, suffix) = splitExtension input_fn
 478       suffix' = drop 1 suffix -- strip off the .
 479       basename | Just b <- mb_basename = b
 480                | otherwise             = input_basename
 481
 482       -- Decide where dump files should go based on the pipeline output
 483       dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
 484       hsc_env = hsc_env0 {hsc_dflags = dflags}
 485
 486         -- If we were given a -x flag, then use that phase to start from
 487       start_phase = fromMaybe (startPhase suffix') mb_phase
 488
 489   -- We want to catch cases of "you can't get there from here" before
 490   -- we start the pipeline, because otherwise it will just run off the
 491   -- end.
 492   --
 493   -- There is a partial ordering on phases, where A < B iff A occurs
 494   -- before B in a normal compilation pipeline.
 495
 496   when (not (start_phase `happensBefore` stop_phase)) $
 497         ghcError (UsageError
 498                     ("cannot compile this file to desired target: "
 499                        ++ input_fn))
 500
 501   -- this is a function which will be used to calculate output file names
 502   -- as we go along (we partially apply it to some of its inputs here)
 503   let get_output_fn = getOutputFilename stop_phase output basename
 504
 505   -- Execute the pipeline...
 506   (dflags', output_fn, maybe_loc) <-
 507         pipeLoop hsc_env start_phase stop_phase input_fn
 508                  basename suffix' get_output_fn maybe_loc
 509
 510   -- Sometimes, a compilation phase doesn't actually generate any output
 511   -- (eg. the CPP phase when -fcpp is not turned on).  If we end on this
 512   -- stage, but we wanted to keep the output, then we have to explicitly
 513   -- copy the file, remembering to prepend a {-# LINE #-} pragma so that
 514   -- further compilation stages can tell what the original filename was.
 515   case output of
 516     Temporary ->
 517         return (dflags', output_fn)
 518     _other -> liftIO $
 519         do final_fn <- get_output_fn dflags' stop_phase maybe_loc
 520            when (final_fn /= output_fn) $ do
 521               let msg = ("Copying `" ++ output_fn ++"' to `" ++ final_fn ++ "'")
 522                   line_prag = Just ("{-# LINE 1 \"" ++ input_fn ++ "\" #-}\n")
 523               copyWithHeader dflags msg line_prag output_fn final_fn
 524            return (dflags', final_fn)
 525
 526
 527
 528 pipeLoop :: GhcMonad m =>
 529             HscEnv -> Phase -> Phase
 530          -> FilePath  -> String -> Suffix
 531          -> (DynFlags -> Phase -> Maybe ModLocation -> IO FilePath)
 532          -> Maybe ModLocation
 533          -> m (DynFlags, FilePath, Maybe ModLocation)
 534
 535 pipeLoop hsc_env phase stop_phase
 536          input_fn orig_basename orig_suff
 537          orig_get_output_fn maybe_loc
 538
 539   | phase `eqPhase` stop_phase            -- All done
 540   = return (hsc_dflags hsc_env, input_fn, maybe_loc)
 541
 542   | not (phase `happensBefore` stop_phase)
 543         -- Something has gone wrong.  We'll try to cover all the cases when
 544         -- this could happen, so if we reach here it is a panic.
 545         -- eg. it might happen if the -C flag is used on a source file that
 546         -- has {-# OPTIONS -fasm #-}.
 547   = panic ("pipeLoop: at phase " ++ show phase ++
 548            " but I wanted to stop at phase " ++ show stop_phase)
 549
 550   | otherwise
 551   = do (next_phase, dflags', maybe_loc, output_fn)
 552           <- runPhase phase stop_phase hsc_env orig_basename
 553                       orig_suff input_fn orig_get_output_fn maybe_loc
 554        let hsc_env' = hsc_env {hsc_dflags = dflags'}
 555        pipeLoop hsc_env' next_phase stop_phase output_fn
 556                 orig_basename orig_suff orig_get_output_fn maybe_loc
 557
 558 getOutputFilename
 559   :: Phase -> PipelineOutput -> String
 560   -> DynFlags -> Phase{-next phase-} -> Maybe ModLocation -> IO FilePath
 561 getOutputFilename stop_phase output basename
 562  = func
 563  where
 564         func dflags next_phase maybe_location
 565            | is_last_phase, Persistent <- output     = persistent_fn
 566            | is_last_phase, SpecificFile f <- output = return f
 567            | keep_this_output                        = persistent_fn
 568            | otherwise                               = newTempName dflags suffix
 569            where
 570                 hcsuf      = hcSuf dflags
 571                 odir       = objectDir dflags
 572                 osuf       = objectSuf dflags
 573                 keep_hc    = dopt Opt_KeepHcFiles dflags
 574                 keep_raw_s = dopt Opt_KeepRawSFiles dflags
 575                 keep_s     = dopt Opt_KeepSFiles dflags
 576
 577                 myPhaseInputExt HCc    = hcsuf
 578                 myPhaseInputExt StopLn = osuf
 579                 myPhaseInputExt other  = phaseInputExt other
 580
 581                 is_last_phase = next_phase `eqPhase` stop_phase
 582
 583                 -- sometimes, we keep output from intermediate stages
 584                 keep_this_output =
 585                      case next_phase of
 586                              StopLn              -> True
 587                              Mangle | keep_raw_s -> True
 588                              As     | keep_s     -> True
 589                              HCc    | keep_hc    -> True
 590                              _other              -> False
 591
 592                 suffix = myPhaseInputExt next_phase
 593
 594                 -- persistent object files get put in odir
 595                 persistent_fn
 596                    | StopLn <- next_phase = return odir_persistent
 597                    | otherwise            = return persistent
 598
 599                 persistent = basename <.> suffix
 600
 601                 odir_persistent
 602                    | Just loc <- maybe_location = ml_obj_file loc
 603                    | Just d <- odir = d </> persistent
 604                    | otherwise      = persistent
 605
 606
 607 -- -----------------------------------------------------------------------------
 608 -- | Each phase in the pipeline returns the next phase to execute, and the
 609 -- name of the file in which the output was placed.
 610 --
 611 -- We must do things dynamically this way, because we often don't know
 612 -- what the rest of the phases will be until part-way through the
 613 -- compilation: for example, an {-# OPTIONS -fasm #-} at the beginning
 614 -- of a source file can change the latter stages of the pipeline from
 615 -- taking the via-C route to using the native code generator.
 616 --
 617 runPhase :: GhcMonad m =>
 618             Phase       -- ^ Do this phase first
 619          -> Phase       -- ^ Stop just before this phase
 620          -> HscEnv
 621          -> String      -- ^ basename of original input source
 622          -> String      -- ^ its extension
 623          -> FilePath    -- ^ name of file which contains the input to this phase.
 624          -> (DynFlags -> Phase -> Maybe ModLocation -> IO FilePath)
 625                         -- ^ how to calculate the output filename
 626          -> Maybe ModLocation           -- ^ the ModLocation, if we have one
 627          -> m (Phase,                   -- next phase
 628                DynFlags,                -- new dynamic flags
 629                Maybe ModLocation,       -- the ModLocation, if we have one
 630                FilePath)                -- output filename
 631
 632         -- Invariant: the output filename always contains the output
 633         -- Interesting case: Hsc when there is no recompilation to do
 634         --                   Then the output filename is still a .o file
 635
 636 -------------------------------------------------------------------------------
 637 -- Unlit phase
 638
 639 runPhase (Unlit sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
 640   = do
 641        let dflags = hsc_dflags hsc_env
 642        output_fn <- liftIO $ get_output_fn dflags (Cpp sf) maybe_loc
 643
 644        let unlit_flags = getOpts dflags opt_L
 645            flags = map SysTools.Option unlit_flags ++
 646                    [ -- The -h option passes the file name for unlit to
 647                      -- put in a #line directive
 648                      SysTools.Option     "-h"
 649                      -- cpp interprets \b etc as escape sequences,
 650                      -- so we use / for filenames in pragmas
 651                    , SysTools.Option $ reslash Forwards $ normalise input_fn
 652                    , SysTools.FileOption "" input_fn
 653                    , SysTools.FileOption "" output_fn
 654                    ]
 655
 656        liftIO $ SysTools.runUnlit dflags flags
 657
 658        return (Cpp sf, dflags, maybe_loc, output_fn)
 659
 660 -------------------------------------------------------------------------------
 661 -- Cpp phase : (a) gets OPTIONS out of file
 662 --             (b) runs cpp if necessary
 663
 664 runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
 665   = do let dflags0 = hsc_dflags hsc_env
 666        src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn
 667        (dflags, unhandled_flags, warns)
 668            <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
 669        liftIO $ handleFlagWarnings dflags warns  -- XXX: may exit the program
 670        liftIO $ checkProcessArgsResult unhandled_flags -- XXX: may throw program error
 671
 672        if not (dopt Opt_Cpp dflags) then
 673            -- no need to preprocess CPP, just pass input file along
 674            -- to the next phase of the pipeline.
 675           return (HsPp sf, dflags, maybe_loc, input_fn)
 676         else do
 677             output_fn <- liftIO $ get_output_fn dflags (HsPp sf) maybe_loc
 678             liftIO $ doCpp dflags True{-raw-} False{-no CC opts-} input_fn output_fn
 679             return (HsPp sf, dflags, maybe_loc, output_fn)
 680
 681 -------------------------------------------------------------------------------
 682 -- HsPp phase
 683
 684 runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc
 685   = do let dflags = hsc_dflags hsc_env
 686        if not (dopt Opt_Pp dflags) then
 687            -- no need to preprocess, just pass input file along
 688            -- to the next phase of the pipeline.
 689           return (Hsc sf, dflags, maybe_loc, input_fn)
 690         else do
 691             let hspp_opts = getOpts dflags opt_F
 692             let orig_fn = basename <.> suff
 693             output_fn <- liftIO $ get_output_fn dflags (Hsc sf) maybe_loc
 694             liftIO $ SysTools.runPp dflags
 695                            ( [ SysTools.Option     orig_fn
 696                              , SysTools.Option     input_fn
 697                              , SysTools.FileOption "" output_fn
 698                              ] ++
 699                              map SysTools.Option hspp_opts
 700                            )
 701             return (Hsc sf, dflags, maybe_loc, output_fn)
 702
 703 -----------------------------------------------------------------------------
 704 -- Hsc phase
 705
 706 -- Compilation of a single module, in "legacy" mode (_not_ under
 707 -- the direction of the compilation manager).
 708 runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _maybe_loc
 709  = do   -- normal Hsc mode, not mkdependHS
 710         let dflags0 = hsc_dflags hsc_env
 711
 712   -- we add the current directory (i.e. the directory in which
 713   -- the .hs files resides) to the include path, since this is
 714   -- what gcc does, and it's probably what you want.
 715         let current_dir = case takeDirectory basename of
 716                       "" -> "." -- XXX Hack
 717                       d -> d
 718
 719             paths = includePaths dflags0
 720             dflags = dflags0 { includePaths = current_dir : paths }
 721
 722   -- gather the imports and module name
 723         (hspp_buf,mod_name,imps,src_imps) <-
 724             case src_flavour of
 725                 ExtCoreFile -> do  -- no explicit imports in ExtCore input.
 726                     m <- liftIO $ getCoreModuleName input_fn
 727                     return (Nothing, mkModuleName m, [], [])
 728
 729                 _           -> liftIO $ do
 730                     buf <- hGetStringBuffer input_fn
 731                     (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)
 732                     return (Just buf, mod_name, imps, src_imps)
 733
 734   -- Build a ModLocation to pass to hscMain.
 735   -- The source filename is rather irrelevant by now, but it's used
 736   -- by hscMain for messages.  hscMain also needs
 737   -- the .hi and .o filenames, and this is as good a way
 738   -- as any to generate them, and better than most. (e.g. takes
 739   -- into accout the -osuf flags)
 740         location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff
 741
 742   -- Boot-ify it if necessary
 743         let location2 | isHsBoot src_flavour = addBootSuffixLocn location1
 744                       | otherwise            = location1
 745
 746
 747   -- Take -ohi into account if present
 748   -- This can't be done in mkHomeModuleLocation because
 749   -- it only applies to the module being compiles
 750         let ohi = outputHi dflags
 751             location3 | Just fn <- ohi = location2{ ml_hi_file = fn }
 752                       | otherwise      = location2
 753
 754   -- Take -o into account if present
 755   -- Very like -ohi, but we must *only* do this if we aren't linking
 756   -- (If we're linking then the -o applies to the linked thing, not to
 757   -- the object file for one module.)
 758   -- Note the nasty duplication with the same computation in compileFile above
 759         let expl_o_file = outputFile dflags
 760             location4 | Just ofile <- expl_o_file
 761                       , isNoLink (ghcLink dflags)
 762                       = location3 { ml_obj_file = ofile }
 763                       | otherwise = location3
 764
 765             o_file = ml_obj_file location4      -- The real object file
 766
 767
 768   -- Figure out if the source has changed, for recompilation avoidance.
 769   --
 770   -- Setting source_unchanged to True means that M.o seems
 771   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 772   -- changed (which the compiler itself figures out).
 773   -- Setting source_unchanged to False tells the compiler that M.o is out of
 774   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 775         src_timestamp <- liftIO $ getModificationTime (basename <.> suff)
 776
 777         let force_recomp = dopt Opt_ForceRecomp dflags
 778         source_unchanged <-
 779           if force_recomp || not (isStopLn stop)
 780                 -- Set source_unchanged to False unconditionally if
 781                 --      (a) recompilation checker is off, or
 782                 --      (b) we aren't going all the way to .o file (e.g. ghc -S)
 783              then return False
 784                 -- Otherwise look at file modification dates
 785              else do o_file_exists <- liftIO $ doesFileExist o_file
 786                      if not o_file_exists
 787                         then return False       -- Need to recompile
 788                         else do t2 <- liftIO $ getModificationTime o_file
 789                                 if t2 > src_timestamp
 790                                   then return True
 791                                   else return False
 792
 793   -- get the DynFlags
 794         let hsc_lang = hscMaybeAdjustTarget dflags stop src_flavour (hscTarget dflags)
 795         let next_phase = hscNextPhase dflags src_flavour hsc_lang
 796         output_fn  <- liftIO $ get_output_fn dflags next_phase (Just location4)
 797
 798         let dflags' = dflags { hscTarget = hsc_lang,
 799                                hscOutName = output_fn,
 800                                extCoreName = basename ++ ".hcr" }
 801
 802         let hsc_env' = hsc_env {hsc_dflags = dflags'}
 803
 804   -- Tell the finder cache about this module
 805         mod <- liftIO $ addHomeModuleToFinder hsc_env' mod_name location4
 806
 807   -- Make the ModSummary to hand to hscMain
 808         let
 809             mod_summary = ModSummary {  ms_mod       = mod,
 810                                         ms_hsc_src   = src_flavour,
 811                                         ms_hspp_file = input_fn,
 812                                         ms_hspp_opts = dflags,
 813                                         ms_hspp_buf  = hspp_buf,
 814                                         ms_location  = location4,
 815                                         ms_hs_date   = src_timestamp,
 816                                         ms_obj_date  = Nothing,
 817                                         ms_imps      = imps,
 818                                         ms_srcimps   = src_imps }
 819
 820   -- run the compiler!
 821         result <- hscCompileOneShot hsc_env'
 822                           mod_summary source_unchanged
 823                           Nothing       -- No iface
 824                           Nothing       -- No "module i of n" progress info
 825
 826         case result of
 827           HscNoRecomp
 828               -> do liftIO $ SysTools.touch dflags' "Touching object file" o_file
 829                     -- The .o file must have a later modification date
 830                     -- than the source file (else we wouldn't be in HscNoRecomp)
 831                     -- but we touch it anyway, to keep 'make' happy (we think).
 832                     return (StopLn, dflags', Just location4, o_file)
 833           (HscRecomp hasStub)
 834               -> do when hasStub $
 835                          do stub_o <- compileStub hsc_env' mod location4
 836                             liftIO $ consIORef v_Ld_inputs stub_o
 837                     -- In the case of hs-boot files, generate a dummy .o-boot
 838                     -- stamp file for the benefit of Make
 839                     when (isHsBoot src_flavour) $
 840                       liftIO $ SysTools.touch dflags' "Touching object file" o_file
 841                     return (next_phase, dflags', Just location4, output_fn)
 842
 843 -----------------------------------------------------------------------------
 844 -- Cmm phase
 845
 846 runPhase CmmCpp _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
 847   = do
 848        let dflags = hsc_dflags hsc_env
 849        output_fn <- liftIO $ get_output_fn dflags Cmm maybe_loc
 850        liftIO $ doCpp dflags False{-not raw-} True{-include CC opts-} input_fn output_fn
 851        return (Cmm, dflags, maybe_loc, output_fn)
 852
 853 runPhase Cmm stop hsc_env basename _ input_fn get_output_fn maybe_loc
 854   = do
 855         let dflags = hsc_dflags hsc_env
 856         let hsc_lang = hscMaybeAdjustTarget dflags stop HsSrcFile (hscTarget dflags)
 857         let next_phase = hscNextPhase dflags HsSrcFile hsc_lang
 858         output_fn <- liftIO $ get_output_fn dflags next_phase maybe_loc
 859
 860         let dflags' = dflags { hscTarget = hsc_lang,
 861                                hscOutName = output_fn,
 862                                extCoreName = basename ++ ".hcr" }
 863         let hsc_env' = hsc_env {hsc_dflags = dflags'}
 864
 865         hscCmmFile hsc_env' input_fn
 866
 867         -- XXX: catch errors above and convert them into ghcError?  Original
 868         -- code was:
 869         --
 870         --when (not ok) $ ghcError (PhaseFailed "cmm" (ExitFailure 1))
 871
 872         return (next_phase, dflags, maybe_loc, output_fn)
 873
 874 -----------------------------------------------------------------------------
 875 -- Cc phase
 876
 877 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 878 -- way too many hacks, and I can't say I've ever used it anyway.
 879
 880 runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
 881    | cc_phase `eqPhase` Cc || cc_phase `eqPhase` Ccpp || cc_phase `eqPhase` HCc
 882    = do let dflags = hsc_dflags hsc_env
 883         let cc_opts = getOpts dflags opt_c
 884             hcc = cc_phase `eqPhase` HCc
 885
 886         let cmdline_include_paths = includePaths dflags
 887
 888         -- HC files have the dependent packages stamped into them
 889         pkgs <- if hcc then liftIO (getHCFilePackages input_fn) else return []
 890
 891         -- add package include paths even if we're just compiling .c
 892         -- files; this is the Value Add(TM) that using ghc instead of
 893         -- gcc gives you :)
 894         pkg_include_dirs <- liftIO $ getPackageIncludePath dflags pkgs
 895         let include_paths = foldr (\ x xs -> "-I" : x : xs) []
 896                               (cmdline_include_paths ++ pkg_include_dirs)
 897
 898         let (md_c_flags, md_regd_c_flags) = machdepCCOpts dflags
 899         gcc_extra_viac_flags <- liftIO $ getExtraViaCOpts dflags
 900         let pic_c_flags = picCCOpts dflags
 901
 902         let verb = getVerbFlag dflags
 903
 904         -- cc-options are not passed when compiling .hc files.  Our
 905         -- hc code doesn't not #include any header files anyway, so these
 906         -- options aren't necessary.
 907         pkg_extra_cc_opts <-
 908           if cc_phase `eqPhase` HCc
 909              then return []
 910              else liftIO $ getPackageExtraCcOpts dflags pkgs
 911
 912 #ifdef darwin_TARGET_OS
 913         pkg_framework_paths <- liftIO $ getPackageFrameworkPath dflags pkgs
 914         let cmdline_framework_paths = frameworkPaths dflags
 915         let framework_paths = map ("-F"++)
 916                         (cmdline_framework_paths ++ pkg_framework_paths)
 917 #endif
 918
 919         let split_objs = dopt Opt_SplitObjs dflags
 920             split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
 921                       | otherwise         = [ ]
 922
 923         let cc_opt | optLevel dflags >= 2 = "-O2"
 924                    | otherwise            = "-O"
 925
 926         -- Decide next phase
 927
 928         let mangle = dopt Opt_DoAsmMangling dflags
 929             next_phase
 930                 | hcc && mangle     = Mangle
 931                 | otherwise         = As
 932         output_fn <- liftIO $ get_output_fn dflags next_phase maybe_loc
 933
 934         let
 935           more_hcc_opts =
 936 #if i386_TARGET_ARCH
 937                 -- on x86 the floating point regs have greater precision
 938                 -- than a double, which leads to unpredictable results.
 939                 -- By default, we turn this off with -ffloat-store unless
 940                 -- the user specified -fexcess-precision.
 941                 (if dopt Opt_ExcessPrecision dflags
 942                         then []
 943                         else [ "-ffloat-store" ]) ++
 944 #endif
 945                 -- gcc's -fstrict-aliasing allows two accesses to memory
 946                 -- to be considered non-aliasing if they have different types.
 947                 -- This interacts badly with the C code we generate, which is
 948                 -- very weakly typed, being derived from C--.
 949                 ["-fno-strict-aliasing"]
 950
 951
 952
 953         liftIO $ SysTools.runCc dflags (
 954                 -- force the C compiler to interpret this file as C when
 955                 -- compiling .hc files, by adding the -x c option.
 956                 -- Also useful for plain .c files, just in case GHC saw a
 957                 -- -x c option.
 958                         [ SysTools.Option "-x", if cc_phase `eqPhase` Ccpp
 959                                                 then SysTools.Option "c++" else SysTools.Option "c"] ++
 960                         [ SysTools.FileOption "" input_fn
 961                         , SysTools.Option "-o"
 962                         , SysTools.FileOption "" output_fn
 963                         ]
 964                        ++ map SysTools.Option (
 965                           md_c_flags
 966                        ++ pic_c_flags
 967 #ifdef sparc_TARGET_ARCH
 968         -- We only support SparcV9 and better because V8 lacks an atomic CAS
 969         -- instruction. Note that the user can still override this
 970         -- (e.g., -mcpu=ultrasparc) as GCC picks the "best" -mcpu flag
 971         -- regardless of the ordering.
 972         --
 973         -- This is a temporary hack.
 974                        ++ ["-mcpu=v9"]
 975 #endif
 976                        ++ (if hcc && mangle
 977                              then md_regd_c_flags
 978                              else [])
 979                        ++ (if hcc
 980                              then if mangle
 981                                      then gcc_extra_viac_flags
 982                                      else filter (=="-fwrapv")
 983                                                 gcc_extra_viac_flags
 984                                 -- still want -fwrapv even for unreg'd
 985                              else [])
 986                        ++ (if hcc
 987                              then more_hcc_opts
 988                              else [])
 989                        ++ [ verb, "-S", "-Wimplicit", cc_opt ]
 990                        ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 991 #ifdef darwin_TARGET_OS
 992                        ++ framework_paths
 993 #endif
 994                        ++ cc_opts
 995                        ++ split_opt
 996                        ++ include_paths
 997                        ++ pkg_extra_cc_opts
 998                        ))
 999
1000         return (next_phase, dflags, maybe_loc, output_fn)
1001
1002         -- ToDo: postprocess the output from gcc
1003
1004 -----------------------------------------------------------------------------
1005 -- Mangle phase
1006
1007 runPhase Mangle _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
1008    = do let dflags = hsc_dflags hsc_env
1009         let mangler_opts = getOpts dflags opt_m
1010
1011 #if i386_TARGET_ARCH
1012         machdep_opts <- return [ show (stolen_x86_regs dflags) ]
1013 #else
1014         machdep_opts <- return []
1015 #endif
1016
1017         let split = dopt Opt_SplitObjs dflags
1018             next_phase
1019                 | split = SplitMangle
1020                 | otherwise = As
1021         output_fn <- liftIO $ get_output_fn dflags next_phase maybe_loc
1022
1023         liftIO $ SysTools.runMangle dflags (map SysTools.Option mangler_opts
1024                           ++ [ SysTools.FileOption "" input_fn
1025                              , SysTools.FileOption "" output_fn
1026                              ]
1027                           ++ map SysTools.Option machdep_opts)
1028
1029         return (next_phase, dflags, maybe_loc, output_fn)
1030
1031 -----------------------------------------------------------------------------
1032 -- Splitting phase
1033
1034 runPhase SplitMangle _stop hsc_env _basename _suff input_fn _get_output_fn maybe_loc
1035   = liftIO $
1036     do  -- tmp_pfx is the prefix used for the split .s files
1037         -- We also use it as the file to contain the no. of split .s files (sigh)
1038         let dflags = hsc_dflags hsc_env
1039         split_s_prefix <- SysTools.newTempName dflags "split"
1040         let n_files_fn = split_s_prefix
1041
1042         SysTools.runSplit dflags
1043                           [ SysTools.FileOption "" input_fn
1044                           , SysTools.FileOption "" split_s_prefix
1045                           , SysTools.FileOption "" n_files_fn
1046                           ]
1047
1048         -- Save the number of split files for future references
1049         s <- readFile n_files_fn
1050         let n_files = read s :: Int
1051         writeIORef v_Split_info (split_s_prefix, n_files)
1052
1053         -- Remember to delete all these files
1054         addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
1055                         | n <- [1..n_files]]
1056
1057         return (SplitAs, dflags, maybe_loc, "**splitmangle**")
1058           -- we don't use the filename
1059
1060 -----------------------------------------------------------------------------
1061 -- As phase
1062
1063 runPhase As _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
1064   = liftIO $
1065     do  let dflags = hsc_dflags hsc_env
1066         let as_opts =  getOpts dflags opt_a
1067         let cmdline_include_paths = includePaths dflags
1068
1069         output_fn <- get_output_fn dflags StopLn maybe_loc
1070
1071         -- we create directories for the object file, because it
1072         -- might be a hierarchical module.
1073         createDirectoryHierarchy (takeDirectory output_fn)
1074
1075         SysTools.runAs dflags
1076                        (map SysTools.Option as_opts
1077                        ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
1078 #ifdef sparc_TARGET_ARCH
1079         -- We only support SparcV9 and better because V8 lacks an atomic CAS
1080         -- instruction so we have to make sure that the assembler accepts the
1081         -- instruction set. Note that the user can still override this
1082         -- (e.g., -mcpu=ultrasparc). GCC picks the "best" -mcpu flag
1083         -- regardless of the ordering.
1084         --
1085         -- This is a temporary hack.
1086                        ++ [ SysTools.Option "-mcpu=v9" ]
1087 #endif
1088                        ++ [ SysTools.Option "-c"
1089                           , SysTools.FileOption "" input_fn
1090                           , SysTools.Option "-o"
1091                           , SysTools.FileOption "" output_fn
1092                           ])
1093
1094         return (StopLn, dflags, maybe_loc, output_fn)
1095
1096
1097 runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc
1098   = liftIO $ do
1099         let dflags = hsc_dflags hsc_env
1100         output_fn <- get_output_fn dflags StopLn maybe_loc
1101
1102         let base_o = dropExtension output_fn
1103             split_odir  = base_o ++ "_split"
1104             osuf = objectSuf dflags
1105
1106         createDirectoryHierarchy split_odir
1107
1108         -- remove M_split/ *.o, because we're going to archive M_split/ *.o
1109         -- later and we don't want to pick up any old objects.
1110         fs <- getDirectoryContents split_odir
1111         mapM_ removeFile $ map (split_odir </>) $ filter (osuf `isSuffixOf`) fs
1112
1113         let as_opts = getOpts dflags opt_a
1114
1115         (split_s_prefix, n) <- readIORef v_Split_info
1116
1117         let split_s   n = split_s_prefix ++ "__" ++ show n <.> "s"
1118             split_obj n = split_odir </>
1119                           takeFileName base_o ++ "__" ++ show n <.> osuf
1120
1121         let assemble_file n
1122               = SysTools.runAs dflags
1123                          (map SysTools.Option as_opts ++
1124                           [ SysTools.Option "-c"
1125                           , SysTools.Option "-o"
1126                           , SysTools.FileOption "" (split_obj n)
1127                           , SysTools.FileOption "" (split_s n)
1128                           ])
1129
1130         mapM_ assemble_file [1..n]
1131
1132         -- and join the split objects into a single object file:
1133         let ld_r args = SysTools.runLink dflags ([
1134                             SysTools.Option "-nostdlib",
1135                             SysTools.Option "-nodefaultlibs",
1136                             SysTools.Option "-Wl,-r",
1137                             SysTools.Option ld_x_flag,
1138                             SysTools.Option "-o",
1139                             SysTools.FileOption "" output_fn ] ++ args)
1140             ld_x_flag | null cLD_X = ""
1141                       | otherwise  = "-Wl,-x"
1142
1143         if cLdIsGNULd == "YES"
1144             then do
1145                   let script = split_odir </> "ld.script"
1146                   writeFile script $
1147                       "INPUT(" ++ unwords (map split_obj [1..n]) ++ ")"
1148                   ld_r [SysTools.FileOption "" script]
1149             else do
1150                   ld_r (map (SysTools.FileOption "" . split_obj) [1..n])
1151
1152         return (StopLn, dflags, maybe_loc, output_fn)
1153
1154 -- warning suppression
1155 runPhase other _stop _dflags _basename _suff _input_fn _get_output_fn _maybe_loc =
1156    panic ("runPhase: don't know how to run phase " ++ show other)
1157 -----------------------------------------------------------------------------
1158 -- MoveBinary sort-of-phase
1159 -- After having produced a binary, move it somewhere else and generate a
1160 -- wrapper script calling the binary. Currently, we need this only in
1161 -- a parallel way (i.e. in GUM), because PVM expects the binary in a
1162 -- central directory.
1163 -- This is called from linkBinary below, after linking. I haven't made it
1164 -- a separate phase to minimise interfering with other modules, and
1165 -- we don't need the generality of a phase (MoveBinary is always
1166 -- done after linking and makes only sense in a parallel setup)   -- HWL
1167
1168 runPhase_MoveBinary :: DynFlags -> FilePath -> [PackageId] -> IO Bool
1169 runPhase_MoveBinary dflags input_fn dep_packages
1170     | WayPar `elem` (wayNames dflags) && not opt_Static =
1171         panic ("Don't know how to combine PVM wrapper and dynamic wrapper")
1172     | WayPar `elem` (wayNames dflags) = do
1173         let sysMan = pgm_sysman dflags
1174         pvm_root <- getEnv "PVM_ROOT"
1175         pvm_arch <- getEnv "PVM_ARCH"
1176         let
1177            pvm_executable_base = "=" ++ input_fn
1178            pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
1179         -- nuke old binary; maybe use configur'ed names for cp and rm?
1180         tryIO (removeFile pvm_executable)
1181         -- move the newly created binary into PVM land
1182         copy dflags "copying PVM executable" input_fn pvm_executable
1183         -- generate a wrapper script for running a parallel prg under PVM
1184         writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
1185         return True
1186     | not opt_Static =
1187         case (dynLibLoader dflags) of
1188           Wrapped wrapmode ->
1189               do
1190                 let (o_base, o_ext) = splitExtension input_fn
1191                 let wrapped_executable | o_ext == "exe" = (o_base ++ ".dyn") <.> o_ext
1192                                        | otherwise = input_fn ++ ".dyn"
1193                 behaviour <- wrapper_behaviour dflags wrapmode dep_packages
1194
1195                 -- THINKME isn't this possible to do a bit nicer?
1196                 let behaviour' = concatMap (\x -> if x=='\\' then "\\\\" else [x]) behaviour
1197                 renameFile input_fn wrapped_executable
1198                 let rtsDetails = (getPackageDetails (pkgState dflags) rtsPackageId);
1199                 SysTools.runCc dflags
1200                   ([ SysTools.FileOption "" ((head (libraryDirs rtsDetails)) ++ "/dyn-wrapper.c")
1201                    , SysTools.Option ("-DBEHAVIOUR=\"" ++ behaviour' ++ "\"")
1202                    , SysTools.Option "-o"
1203                    , SysTools.FileOption "" input_fn
1204                    ] ++ map (SysTools.FileOption "-I") (includeDirs rtsDetails))
1205                 return True
1206           _ -> return True
1207     | otherwise = return True
1208
1209 wrapper_behaviour :: DynFlags -> Maybe [Char] -> [PackageId] -> IO [Char]
1210 wrapper_behaviour dflags mode dep_packages =
1211     let seperateBySemiColon strs = tail $ concatMap (';':) strs
1212     in case mode of
1213       Nothing -> do
1214                 pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
1215                 return ('H' : (seperateBySemiColon pkg_lib_paths))
1216       Just s -> do
1217         allpkg <- getPreloadPackagesAnd dflags dep_packages
1218         putStrLn (unwords (map (packageIdString . packageConfigId) allpkg))
1219         return $ 'F':s ++ ';':(seperateBySemiColon (map (packageIdString . packageConfigId) allpkg))
1220
1221 -- generates a Perl skript starting a parallel prg under PVM
1222 mk_pvm_wrapper_script :: String -> String -> String -> String
1223 mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
1224  [
1225   "eval 'exec perl -S $0 ${1+\"$@\"}'",
1226   "  if $running_under_some_shell;",
1227   "# =!=!=!=!=!=!=!=!=!=!=!",
1228   "# This script is automatically generated: DO NOT EDIT!!!",
1229   "# Generated by Glasgow Haskell Compiler",
1230   "# ngoqvam choHbogh vaj' vIHoHnISbej !!!!",
1231   "#",
1232   "$pvm_executable      = '" ++ pvm_executable ++ "';",
1233   "$pvm_executable_base = '" ++ pvm_executable_base ++ "';",
1234   "$SysMan = '" ++ sysMan ++ "';",
1235   "",
1236   {- ToDo: add the magical shortcuts again iff we actually use them -- HWL
1237   "# first, some magical shortcuts to run "commands" on the binary",
1238   "# (which is hidden)",
1239   "if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {",
1240   "    local($cmd) = $1;",
1241   "    system("$cmd $pvm_executable");",
1242   "    exit(0); # all done",
1243   "}", -}
1244   "",
1245   "# Now, run the real binary; process the args first",
1246   "$ENV{'PE'} = $pvm_executable_base;", --  ++ pvm_executable_base,
1247   "$debug = '';",
1248   "$nprocessors = 0; # the default: as many PEs as machines in PVM config",
1249   "@nonPVM_args = ();",
1250   "$in_RTS_args = 0;",
1251   "",
1252   "args: while ($a = shift(@ARGV)) {",
1253   "    if ( $a eq '+RTS' ) {",
1254   "        $in_RTS_args = 1;",
1255   "    } elsif ( $a eq '-RTS' ) {",
1256   "        $in_RTS_args = 0;",
1257   "    }",
1258   "    if ( $a eq '-d' && $in_RTS_args ) {",
1259   "        $debug = '-';",
1260   "    } elsif ( $a =~ /^-qN(\\d+)/ && $in_RTS_args ) {",
1261   "        $nprocessors = $1;",
1262   "    } elsif ( $a =~ /^-qp(\\d+)/ && $in_RTS_args ) {",
1263   "        $nprocessors = $1;",
1264   "    } else {",
1265   "        push(@nonPVM_args, $a);",
1266   "    }",
1267   "}",
1268   "",
1269   "local($return_val) = 0;",
1270   "# Start the parallel execution by calling SysMan",
1271   "system(\"$SysMan $debug $pvm_executable $nprocessors @nonPVM_args\");",
1272   "$return_val = $?;",
1273   "# ToDo: fix race condition moving files and flushing them!!",
1274   "system(\"cp $ENV{'HOME'}/$pvm_executable_base.???.gr .\") if -f \"$ENV{'HOME'}/$pvm_executable_base.002.gr\";",
1275   "exit($return_val);"
1276  ]
1277
1278 -----------------------------------------------------------------------------
1279 -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
1280
1281 getHCFilePackages :: FilePath -> IO [PackageId]
1282 getHCFilePackages filename =
1283   Exception.bracket (openFile filename ReadMode) hClose $ \h -> do
1284     l <- hGetLine h
1285     case l of
1286       '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->
1287           return (map stringToPackageId (words rest))
1288       _other ->
1289           return []
1290
1291 -----------------------------------------------------------------------------
1292 -- Static linking, of .o files
1293
1294 -- The list of packages passed to link is the list of packages on
1295 -- which this program depends, as discovered by the compilation
1296 -- manager.  It is combined with the list of packages that the user
1297 -- specifies on the command line with -package flags.
1298 --
1299 -- In one-shot linking mode, we can't discover the package
1300 -- dependencies (because we haven't actually done any compilation or
1301 -- read any interface files), so the user must explicitly specify all
1302 -- the packages.
1303
1304 linkBinary :: DynFlags -> [FilePath] -> [PackageId] -> IO ()
1305 linkBinary dflags o_files dep_packages = do
1306     let verb = getVerbFlag dflags
1307         output_fn = exeFileName dflags
1308
1309     -- get the full list of packages to link with, by combining the
1310     -- explicit packages with the auto packages and all of their
1311     -- dependencies, and eliminating duplicates.
1312
1313     pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
1314     let pkg_lib_path_opts = concat (map get_pkg_lib_path_opts pkg_lib_paths)
1315 #ifdef linux_TARGET_OS
1316         get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
1317                                 | otherwise = ["-L" ++ l]
1318 #else
1319         get_pkg_lib_path_opts l = ["-L" ++ l]
1320 #endif
1321
1322     let lib_paths = libraryPaths dflags
1323     let lib_path_opts = map ("-L"++) lib_paths
1324
1325     pkg_link_opts <- getPackageLinkOpts dflags dep_packages
1326
1327 #ifdef darwin_TARGET_OS
1328     pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
1329     let pkg_framework_path_opts = map ("-F"++) pkg_framework_paths
1330
1331     let framework_paths = frameworkPaths dflags
1332         framework_path_opts = map ("-F"++) framework_paths
1333
1334     pkg_frameworks <- getPackageFrameworks dflags dep_packages
1335     let pkg_framework_opts = concat [ ["-framework", fw] | fw <- pkg_frameworks ]
1336
1337     let frameworks = cmdlineFrameworks dflags
1338         framework_opts = concat [ ["-framework", fw] | fw <- reverse frameworks ]
1339          -- reverse because they're added in reverse order from the cmd line
1340 #endif
1341 #ifdef mingw32_TARGET_OS
1342     let dynMain = if not opt_Static then
1343                       (head (libraryDirs (getPackageDetails (pkgState dflags) rtsPackageId))) ++ "/Main.dyn_o"
1344                   else
1345                       ""
1346 #endif
1347         -- probably _stub.o files
1348     extra_ld_inputs <- readIORef v_Ld_inputs
1349
1350         -- opts from -optl-<blah> (including -l<blah> options)
1351     let extra_ld_opts = getOpts dflags opt_l
1352
1353     let ways = wayNames dflags
1354
1355     -- Here are some libs that need to be linked at the *end* of
1356     -- the command line, because they contain symbols that are referred to
1357     -- by the RTS.  We can't therefore use the ordinary way opts for these.
1358     let
1359         debug_opts | WayDebug `elem` ways = [
1360 #if defined(HAVE_LIBBFD)
1361                         "-lbfd", "-liberty"
1362 #endif
1363                          ]
1364                    | otherwise            = []
1365
1366     let
1367         thread_opts | WayThreaded `elem` ways = [
1368 #if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS)
1369                         "-lpthread"
1370 #endif
1371 #if defined(osf3_TARGET_OS)
1372                         , "-lexc"
1373 #endif
1374                         ]
1375                     | otherwise               = []
1376
1377     rc_objs <- maybeCreateManifest dflags output_fn
1378
1379     let (md_c_flags, _) = machdepCCOpts dflags
1380     SysTools.runLink dflags (
1381                        [ SysTools.Option verb
1382                        , SysTools.Option "-o"
1383                        , SysTools.FileOption "" output_fn
1384                        ]
1385                       ++ map SysTools.Option (
1386                          md_c_flags
1387                       ++ o_files
1388 #ifdef mingw32_TARGET_OS
1389                       ++ [dynMain]
1390 #endif
1391                       ++ extra_ld_inputs
1392                       ++ lib_path_opts
1393                       ++ extra_ld_opts
1394                       ++ rc_objs
1395 #ifdef darwin_TARGET_OS
1396                       ++ framework_path_opts
1397                       ++ framework_opts
1398 #endif
1399                       ++ pkg_lib_path_opts
1400                       ++ pkg_link_opts
1401 #ifdef darwin_TARGET_OS
1402                       ++ pkg_framework_path_opts
1403                       ++ pkg_framework_opts
1404 #endif
1405                       ++ debug_opts
1406                       ++ thread_opts
1407                     ))
1408
1409     -- parallel only: move binary to another dir -- HWL
1410     success <- runPhase_MoveBinary dflags output_fn dep_packages
1411     if success then return ()
1412                else ghcError (InstallationError ("cannot move binary"))
1413
1414
1415 exeFileName :: DynFlags -> FilePath
1416 exeFileName dflags
1417   | Just s <- outputFile dflags =
1418 #if defined(mingw32_HOST_OS)
1419       if null (takeExtension s)
1420         then s <.> "exe"
1421         else s
1422 #else
1423       s
1424 #endif
1425   | otherwise =
1426 #if defined(mingw32_HOST_OS)
1427         "main.exe"
1428 #else
1429         "a.out"
1430 #endif
1431
1432 maybeCreateManifest
1433    :: DynFlags
1434    -> FilePath                          -- filename of executable
1435    -> IO [FilePath]                     -- extra objects to embed, maybe
1436 #ifndef mingw32_TARGET_OS
1437 maybeCreateManifest _ _ = do
1438   return []
1439 #else
1440 maybeCreateManifest dflags exe_filename = do
1441   if not (dopt Opt_GenManifest dflags) then return [] else do
1442
1443   let manifest_filename = exe_filename <.> "manifest"
1444
1445   writeFile manifest_filename $
1446       "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"++
1447       "  <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"++
1448       "  <assemblyIdentity version=\"1.0.0.0\"\n"++
1449       "     processorArchitecture=\"X86\"\n"++
1450       "     name=\"" ++ dropExtension exe_filename ++ "\"\n"++
1451       "     type=\"win32\"/>\n\n"++
1452       "  <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"++
1453       "    <security>\n"++
1454       "      <requestedPrivileges>\n"++
1455       "        <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n"++
1456       "        </requestedPrivileges>\n"++
1457       "       </security>\n"++
1458       "  </trustInfo>\n"++
1459       "</assembly>\n"
1460
1461   -- Windows will find the manifest file if it is named foo.exe.manifest.
1462   -- However, for extra robustness, and so that we can move the binary around,
1463   -- we can embed the manifest in the binary itself using windres:
1464   if not (dopt Opt_EmbedManifest dflags) then return [] else do
1465
1466   rc_filename <- newTempName dflags "rc"
1467   rc_obj_filename <- newTempName dflags (objectSuf dflags)
1468
1469   writeFile rc_filename $
1470       "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
1471         -- magic numbers :-)
1472         -- show is a bit hackish above, but we need to escape the
1473         -- backslashes in the path.
1474
1475   let wr_opts = getOpts dflags opt_windres
1476   runWindres dflags $ map SysTools.Option $
1477         ["--input="++rc_filename,
1478          "--output="++rc_obj_filename,
1479          "--output-format=coff"]
1480         ++ wr_opts
1481         -- no FileOptions here: windres doesn't like seeing
1482         -- backslashes, apparently
1483
1484   return [rc_obj_filename]
1485 #endif
1486
1487
1488 linkDynLib :: DynFlags -> [String] -> [PackageId] -> IO ()
1489 linkDynLib dflags o_files dep_packages = do
1490     let verb = getVerbFlag dflags
1491     let o_file = outputFile dflags
1492
1493     -- We don't want to link our dynamic libs against the RTS package,
1494     -- because the RTS lib comes in several flavours and we want to be
1495     -- able to pick the flavour when a binary is linked.
1496     pkgs <- getPreloadPackagesAnd dflags dep_packages
1497     let pkgs_no_rts = filter ((/= rtsPackageId) . packageConfigId) pkgs
1498
1499     let pkg_lib_paths = collectLibraryPaths pkgs_no_rts
1500     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
1501
1502     let lib_paths = libraryPaths dflags
1503     let lib_path_opts = map ("-L"++) lib_paths
1504
1505     let pkg_link_opts = collectLinkOpts dflags pkgs_no_rts
1506
1507         -- probably _stub.o files
1508     extra_ld_inputs <- readIORef v_Ld_inputs
1509
1510     let (md_c_flags, _) = machdepCCOpts dflags
1511     let extra_ld_opts = getOpts dflags opt_l
1512 #if defined(mingw32_HOST_OS)
1513     -----------------------------------------------------------------------------
1514     -- Making a DLL
1515     -----------------------------------------------------------------------------
1516     let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
1517
1518     SysTools.runLink dflags
1519          ([ SysTools.Option verb
1520           , SysTools.Option "-o"
1521           , SysTools.FileOption "" output_fn
1522           , SysTools.Option "-shared"
1523           , SysTools.FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
1524           ]
1525          ++ map (SysTools.FileOption "") o_files
1526          ++ map SysTools.Option (
1527             md_c_flags
1528          ++ extra_ld_inputs
1529          ++ lib_path_opts
1530          ++ extra_ld_opts
1531          ++ pkg_lib_path_opts
1532          ++ pkg_link_opts
1533         ))
1534 #elif defined(darwin_TARGET_OS)
1535     -----------------------------------------------------------------------------
1536     -- Making a darwin dylib
1537     -----------------------------------------------------------------------------
1538     -- About the options used for Darwin:
1539     -- -dynamiclib
1540     --   Apple's way of saying -shared
1541     -- -undefined dynamic_lookup:
1542     --   Without these options, we'd have to specify the correct dependencies
1543     --   for each of the dylibs. Note that we could (and should) do without this
1544     --   for all libraries except the RTS; all we need to do is to pass the
1545     --   correct HSfoo_dyn.dylib files to the link command.
1546     --   This feature requires Mac OS X 10.3 or later; there is a similar feature,
1547     --   -flat_namespace -undefined suppress, which works on earlier versions,
1548     --   but it has other disadvantages.
1549     -- -single_module
1550     --   Build the dynamic library as a single "module", i.e. no dynamic binding
1551     --   nonsense when referring to symbols from within the library. The NCG
1552     --   assumes that this option is specified (on i386, at least).
1553     -- -Wl,-macosx_version_min -Wl,10.3
1554     --   Tell the linker its safe to assume that the library will run on 10.3 or
1555     --   later, so that it will not complain about the use of the option
1556     --   -undefined dynamic_lookup above.
1557     -- -install_name
1558     --   Causes the dynamic linker to ignore the DYLD_LIBRARY_PATH when loading
1559     --   this lib and instead look for it at its absolute path.
1560     --   When installing the .dylibs (see target.mk), we'll change that path to
1561     --   point to the place they are installed. Therefore, we won't have to set
1562     --   up DYLD_LIBRARY_PATH specifically for ghc.
1563     -----------------------------------------------------------------------------
1564
1565     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
1566
1567     pwd <- getCurrentDirectory
1568     SysTools.runLink dflags
1569          ([ SysTools.Option verb
1570           , SysTools.Option "-dynamiclib"
1571           , SysTools.Option "-o"
1572           , SysTools.FileOption "" output_fn
1573           ]
1574          ++ map SysTools.Option (
1575             md_c_flags
1576          ++ o_files
1577          ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.3", "-install_name " ++ (pwd </> output_fn) ]
1578          ++ extra_ld_inputs
1579          ++ lib_path_opts
1580          ++ extra_ld_opts
1581          ++ pkg_lib_path_opts
1582          ++ pkg_link_opts
1583         ))
1584 #else
1585     -----------------------------------------------------------------------------
1586     -- Making a DSO
1587     -----------------------------------------------------------------------------
1588
1589     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
1590
1591     SysTools.runLink dflags
1592          ([ SysTools.Option verb
1593           , SysTools.Option "-o"
1594           , SysTools.FileOption "" output_fn
1595           ]
1596          ++ map SysTools.Option (
1597             md_c_flags
1598          ++ o_files
1599          ++ [ "-shared", "-Wl,-Bsymbolic" ] -- we need symbolic linking to resolve non-PIC intra-package-relocations
1600          ++ extra_ld_inputs
1601          ++ lib_path_opts
1602          ++ extra_ld_opts
1603          ++ pkg_lib_path_opts
1604          ++ pkg_link_opts
1605         ))
1606 #endif
1607 -- -----------------------------------------------------------------------------
1608 -- Running CPP
1609
1610 doCpp :: DynFlags -> Bool -> Bool -> FilePath -> FilePath -> IO ()
1611 doCpp dflags raw include_cc_opts input_fn output_fn = do
1612     let hscpp_opts = getOpts dflags opt_P
1613     let cmdline_include_paths = includePaths dflags
1614
1615     pkg_include_dirs <- getPackageIncludePath dflags []
1616     let include_paths = foldr (\ x xs -> "-I" : x : xs) []
1617                           (cmdline_include_paths ++ pkg_include_dirs)
1618
1619     let verb = getVerbFlag dflags
1620
1621     let cc_opts
1622           | not include_cc_opts = []
1623           | otherwise           = (optc ++ md_c_flags)
1624                 where
1625                       optc = getOpts dflags opt_c
1626                       (md_c_flags, _) = machdepCCOpts dflags
1627
1628     let cpp_prog args | raw       = SysTools.runCpp dflags args
1629                       | otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
1630
1631     let target_defs =
1632           [ "-D" ++ HOST_OS     ++ "_BUILD_OS=1",
1633             "-D" ++ HOST_ARCH   ++ "_BUILD_ARCH=1",
1634             "-D" ++ TARGET_OS   ++ "_HOST_OS=1",
1635             "-D" ++ TARGET_ARCH ++ "_HOST_ARCH=1" ]
1636         -- remember, in code we *compile*, the HOST is the same our TARGET,
1637         -- and BUILD is the same as our HOST.
1638
1639     cpp_prog       ([SysTools.Option verb]
1640                     ++ map SysTools.Option include_paths
1641                     ++ map SysTools.Option hsSourceCppOpts
1642                     ++ map SysTools.Option hscpp_opts
1643                     ++ map SysTools.Option cc_opts
1644                     ++ map SysTools.Option target_defs
1645                     ++ [ SysTools.Option     "-x"
1646                        , SysTools.Option     "c"
1647                        , SysTools.Option     input_fn
1648         -- We hackily use Option instead of FileOption here, so that the file
1649         -- name is not back-slashed on Windows.  cpp is capable of
1650         -- dealing with / in filenames, so it works fine.  Furthermore
1651         -- if we put in backslashes, cpp outputs #line directives
1652         -- with *double* backslashes.   And that in turn means that
1653         -- our error messages get double backslashes in them.
1654         -- In due course we should arrange that the lexer deals
1655         -- with these \\ escapes properly.
1656                        , SysTools.Option     "-o"
1657                        , SysTools.FileOption "" output_fn
1658                        ])
1659
1660 cHaskell1Version :: String
1661 cHaskell1Version = "5" -- i.e., Haskell 98
1662
1663 hsSourceCppOpts :: [String]
1664 -- Default CPP defines in Haskell source
1665 hsSourceCppOpts =
1666         [ "-D__HASKELL1__="++cHaskell1Version
1667         , "-D__GLASGOW_HASKELL__="++cProjectVersionInt
1668         , "-D__HASKELL98__"
1669         , "-D__CONCURRENT_HASKELL__"
1670         ]
1671
1672
1673 -- -----------------------------------------------------------------------------
1674 -- Misc.
1675
1676 hscNextPhase :: DynFlags -> HscSource -> HscTarget -> Phase
1677 hscNextPhase _ HsBootFile _        =  StopLn
1678 hscNextPhase dflags _ hsc_lang =
1679   case hsc_lang of
1680         HscC -> HCc
1681         HscAsm | dopt Opt_SplitObjs dflags -> SplitMangle
1682                | otherwise -> As
1683         HscNothing     -> StopLn
1684         HscInterpreted -> StopLn
1685         _other         -> StopLn
1686
1687
1688 hscMaybeAdjustTarget :: DynFlags -> Phase -> HscSource -> HscTarget -> HscTarget
1689 hscMaybeAdjustTarget dflags stop _ current_hsc_lang
1690   = hsc_lang
1691   where
1692         keep_hc = dopt Opt_KeepHcFiles dflags
1693         hsc_lang
1694                 -- don't change the lang if we're interpreting
1695                  | current_hsc_lang == HscInterpreted = current_hsc_lang
1696
1697                 -- force -fvia-C if we are being asked for a .hc file
1698                  | HCc <- stop = HscC
1699                  | keep_hc     = HscC
1700                 -- otherwise, stick to the plan
1701                  | otherwise = current_hsc_lang
1702
1703 GLOBAL_VAR(v_Split_info, ("",0), (String,Int))
1704         -- The split prefix and number of files