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