ghc/compiler/main/DriverPipeline.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- GHC Driver
   4 --
   5 -- (c) The University of Glasgow 2002
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 #include "../includes/config.h"
  10
  11 module DriverPipeline (
  12
  13         -- Interfaces for the batch-mode driver
  14    genPipeline, runPipeline, pipeLoop, staticLink,
  15
  16         -- Interfaces for the compilation manager (interpreted/batch-mode)
  17    preprocess,
  18    compile, CompResult(..),
  19    link,
  20
  21         -- DLL building
  22    doMkDLL
  23   ) where
  24
  25 #include "HsVersions.h"
  26
  27 import Packages
  28 import GetImports
  29 import DriverState
  30 import DriverUtil
  31 import DriverMkDepend
  32 import DriverPhases
  33 import DriverFlags
  34 import SysTools         ( newTempName, addFilesToClean, getSysMan, copy )
  35 import qualified SysTools
  36 import HscMain
  37 import Finder
  38 import HscTypes
  39 import Outputable
  40 import Module
  41 import ErrUtils
  42 import CmdLineOpts
  43 import Config
  44 import Panic
  45 import Util
  46 import BasicTypes       ( SuccessFlag(..) )
  47 import Maybes           ( expectJust )
  48
  49 import ParserCoreUtils ( getCoreModuleName )
  50
  51 import EXCEPTION
  52 import DATA_IOREF       ( readIORef, writeIORef )
  53
  54 #ifdef GHCI
  55 import Time             ( getClockTime )
  56 #endif
  57 import Directory
  58 import System
  59 import IO
  60 import Monad
  61 import Maybe
  62
  63
  64 -----------------------------------------------------------------------------
  65 --                      Pre process
  66 -----------------------------------------------------------------------------
  67
  68 -- Just preprocess a file, put the result in a temp. file (used by the
  69 -- compilation manager during the summary phase).
  70
  71 preprocess :: FilePath -> IO FilePath
  72 preprocess filename =
  73   ASSERT(haskellish_src_file filename)
  74   do restoreDynFlags    -- Restore to state of last save
  75      let fInfo = (filename, getFileSuffix filename)
  76      pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False
  77                              defaultHscLang fInfo
  78      (fn,_)   <- runPipeline pipeline fInfo
  79                              False{-no linking-} False{-no -o flag-}
  80      return fn
  81
  82 -----------------------------------------------------------------------------
  83 --                      Compile
  84 -----------------------------------------------------------------------------
  85
  86 -- Compile a single module, under the control of the compilation manager.
  87 --
  88 -- This is the interface between the compilation manager and the
  89 -- compiler proper (hsc), where we deal with tedious details like
  90 -- reading the OPTIONS pragma from the source file, and passing the
  91 -- output of hsc through the C compiler.
  92
  93 -- The driver sits between 'compile' and 'hscMain', translating calls
  94 -- to the former into calls to the latter, and results from the latter
  95 -- into results from the former.  It does things like preprocessing
  96 -- the .hs file if necessary, and compiling up the .stub_c files to
  97 -- generate Linkables.
  98
  99 -- NB.  No old interface can also mean that the source has changed.
 100
 101 compile :: GhciMode                -- distinguish batch from interactive
 102         -> Module
 103         -> ModLocation
 104         -> Bool                    -- True <=> source unchanged
 105         -> Bool                    -- True <=> have object
 106         -> Maybe ModIface          -- old interface, if available
 107         -> HomePackageTable        -- For home-module stuff
 108         -> PersistentCompilerState -- persistent compiler state
 109         -> IO CompResult
 110
 111 data CompResult
 112    = CompOK   PersistentCompilerState   -- Updated PCS
 113               ModDetails                -- New details
 114               ModIface                  -- New iface
 115               (Maybe Linkable)  -- New code; Nothing => compilation was not reqd
 116                                 --                      (old code is still valid)
 117
 118    | CompErrs PersistentCompilerState   -- Updated PCS
 119
 120
 121 compile ghci_mode this_mod location
 122         source_unchanged have_object
 123         old_iface hpt pcs = do
 124
 125    dyn_flags <- restoreDynFlags         -- Restore to the state of the last save
 126
 127
 128    showPass dyn_flags
 129         (showSDoc (text "Compiling" <+> ppr this_mod))
 130
 131    let verb       = verbosity dyn_flags
 132    let input_fn   = expectJust "compile:hs" (ml_hs_file location)
 133    let input_fnpp = expectJust "compile:hspp" (ml_hspp_file location)
 134    let mod_name   = moduleName this_mod
 135
 136    when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
 137
 138    opts <- getOptionsFromSource input_fnpp
 139    processArgs dynamic_flags opts []
 140    dyn_flags <- getDynFlags
 141
 142    let hsc_lang      = hscLang dyn_flags
 143        (basename, _) = splitFilename input_fn
 144
 145    keep_hc <- readIORef v_Keep_hc_files
 146 #ifdef ILX
 147    keep_il <- readIORef v_Keep_il_files
 148 #endif
 149    keep_s  <- readIORef v_Keep_s_files
 150
 151    output_fn <-
 152         case hsc_lang of
 153            HscAsm  | keep_s    -> return (basename ++ '.':phaseInputExt As)
 154                    | otherwise -> newTempName (phaseInputExt As)
 155            HscC    | keep_hc   -> return (basename ++ '.':phaseInputExt HCc)
 156                    | otherwise -> newTempName (phaseInputExt HCc)
 157            HscJava             -> newTempName "java" -- ToDo
 158 #ifdef ILX
 159            HscILX  | keep_il   -> return (basename ++ '.':phaseInputExt Ilasm)
 160                    | otherwise -> newTempName (phaseInputExt Ilx2Il)
 161 #endif
 162            HscInterpreted      -> return (error "no output file")
 163            HscNothing          -> return (error "no output file")
 164
 165    let dyn_flags' = dyn_flags { hscOutName = output_fn,
 166                                 hscStubCOutName = basename ++ "_stub.c",
 167                                 hscStubHOutName = basename ++ "_stub.h",
 168                                 extCoreName = basename ++ ".hcr" }
 169
 170    -- figure out which header files to #include in a generated .hc file
 171    c_includes <- getPackageCIncludes
 172    cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
 173
 174    let cc_injects = unlines (map mk_include
 175                                  (c_includes ++ reverse cmdline_includes))
 176        mk_include h_file =
 177         case h_file of
 178            '"':_{-"-} -> "#include "++h_file
 179            '<':_      -> "#include "++h_file
 180            _          -> "#include \""++h_file++"\""
 181
 182    writeIORef v_HCHeader cc_injects
 183
 184    -- -no-recomp should also work with --make
 185    do_recomp <- readIORef v_Recomp
 186    let source_unchanged' = source_unchanged && do_recomp
 187        hsc_env = HscEnv { hsc_mode = ghci_mode,
 188                           hsc_dflags = dyn_flags',
 189                           hsc_HPT    = hpt }
 190
 191    -- run the compiler
 192    hsc_result <- hscMain hsc_env pcs this_mod location
 193                          source_unchanged' have_object old_iface
 194
 195    case hsc_result of
 196       HscFail pcs -> return (CompErrs pcs)
 197
 198       HscNoRecomp pcs details iface -> return (CompOK pcs details iface Nothing)
 199
 200       HscRecomp pcs details iface
 201         stub_h_exists stub_c_exists maybe_interpreted_code -> do
 202            let
 203            maybe_stub_o <- compileStub dyn_flags' stub_c_exists
 204            let stub_unlinked = case maybe_stub_o of
 205                                   Nothing -> []
 206                                   Just stub_o -> [ DotO stub_o ]
 207
 208            (hs_unlinked, unlinked_time) <-
 209              case hsc_lang of
 210
 211                 -- in interpreted mode, just return the compiled code
 212                 -- as our "unlinked" object.
 213                 HscInterpreted ->
 214                     case maybe_interpreted_code of
 215 #ifdef GHCI
 216                        Just comp_bc -> do tm <- getClockTime
 217                                           return ([BCOs comp_bc], tm)
 218 #endif
 219                        Nothing -> panic "compile: no interpreted code"
 220
 221                 -- we're in batch mode: finish the compilation pipeline.
 222                 _other -> do pipe <- genPipeline (StopBefore Ln) "" True
 223                                         hsc_lang (output_fn, getFileSuffix output_fn)
 224                              -- runPipeline takes input_fn so it can split off
 225                              -- the base name and use it as the base of
 226                              -- the output object file.
 227                              let (basename, suffix) = splitFilename input_fn
 228                              (o_file,_) <-
 229                                  pipeLoop pipe (output_fn, getFileSuffix output_fn)
 230                                                False False
 231                                                basename suffix
 232                              o_time <- getModificationTime o_file
 233                              return ([DotO o_file], o_time)
 234
 235            let linkable = LM unlinked_time mod_name
 236                              (hs_unlinked ++ stub_unlinked)
 237
 238            return (CompOK pcs details iface (Just linkable))
 239
 240 -----------------------------------------------------------------------------
 241 -- stub .h and .c files (for foreign export support)
 242
 243 compileStub dflags stub_c_exists
 244   | not stub_c_exists = return Nothing
 245   | stub_c_exists = do
 246         -- compile the _stub.c file w/ gcc
 247         let stub_c = hscStubCOutName dflags
 248         pipeline   <- genPipeline (StopBefore Ln) "" True defaultHscLang (stub_c,"c")
 249         (stub_o,_) <- runPipeline pipeline (stub_c,"c") False{-no linking-}
 250                                   False{-no -o option-}
 251         return (Just stub_o)
 252
 253
 254 -----------------------------------------------------------------------------
 255 --                      Link
 256 -----------------------------------------------------------------------------
 257
 258 link :: GhciMode                -- interactive or batch
 259      -> DynFlags                -- dynamic flags
 260      -> Bool                    -- attempt linking in batch mode?
 261      -> [Linkable]
 262      -> IO SuccessFlag
 263
 264 -- For the moment, in the batch linker, we don't bother to tell doLink
 265 -- which packages to link -- it just tries all that are available.
 266 -- batch_attempt_linking should only be *looked at* in batch mode.  It
 267 -- should only be True if the upsweep was successful and someone
 268 -- exports main, i.e., we have good reason to believe that linking
 269 -- will succeed.
 270
 271 -- There will be (ToDo: are) two lists passed to link.  These
 272 -- correspond to
 273 --
 274 --      1. The list of all linkables in the current home package.  This is
 275 --         used by the batch linker to link the program, and by the interactive
 276 --         linker to decide which modules from the previous link it can
 277 --         throw away.
 278 --      2. The list of modules on which we just called "compile".  This list
 279 --         is used by the interactive linker to decide which modules need
 280 --         to be actually linked this time around (or unlinked and re-linked
 281 --         if the module was recompiled).
 282
 283 link mode dflags batch_attempt_linking linkables
 284    = do let verb = verbosity dflags
 285         when (verb >= 3) $ do
 286              hPutStrLn stderr "link: linkables are ..."
 287              hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
 288
 289         res <- link' mode dflags batch_attempt_linking linkables
 290
 291         when (verb >= 3) (hPutStrLn stderr "link: done")
 292
 293         return res
 294
 295 #ifdef GHCI
 296 link' Interactive dflags batch_attempt_linking linkables
 297     = do showPass dflags "Not Linking...(demand linker will do the job)"
 298          -- linkModules dflags linkables
 299          return Succeeded
 300 #endif
 301
 302 link' Batch dflags batch_attempt_linking linkables
 303    | batch_attempt_linking
 304    = do
 305         -- check for the -no-link flag
 306         omit_linking <- readIORef v_NoLink
 307         if omit_linking
 308           then do when (verb >= 3) $
 309                     hPutStrLn stderr "link(batch): linking omitted (-no-link flag given)."
 310                   return Succeeded
 311           else do
 312
 313         when (verb >= 1) $
 314              hPutStrLn stderr "Linking ..."
 315
 316         -- Don't showPass in Batch mode; doLink will do that for us.
 317         staticLink (concatMap getOfiles linkables)
 318
 319         -- staticLink only returns if it succeeds
 320         return Succeeded
 321
 322    | otherwise
 323    = do when (verb >= 3) $ do
 324             hPutStrLn stderr "link(batch): upsweep (partially) failed OR"
 325             hPutStrLn stderr "   Main.main not exported; not linking."
 326         return Succeeded
 327    where
 328       verb = verbosity dflags
 329       getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
 330
 331
 332
 333 -----------------------------------------------------------------------------
 334 --                      genPipeline: Pipeline construction
 335 -----------------------------------------------------------------------------
 336
 337 -- Herein is all the magic about which phases to run in which order, whether
 338 -- the intermediate files should be in TMPDIR or in the current directory,
 339 -- what the suffix of the intermediate files should be, etc.
 340
 341 -- The following compilation pipeline algorithm is fairly hacky.  A
 342 -- better way to do this would be to express the whole compilation as a
 343 -- data flow DAG, where the nodes are the intermediate files and the
 344 -- edges are the compilation phases.  This framework would also work
 345 -- nicely if a haskell dependency generator was included in the
 346 -- driver.
 347
 348 -- It would also deal much more cleanly with compilation phases that
 349 -- generate multiple intermediates, (eg. hsc generates .hc, .hi, and
 350 -- possibly stub files), where some of the output files need to be
 351 -- processed further (eg. the stub files need to be compiled by the C
 352 -- compiler).
 353
 354 -- A cool thing to do would then be to execute the data flow graph
 355 -- concurrently, automatically taking advantage of extra processors on
 356 -- the host machine.  For example, when compiling two Haskell files
 357 -- where one depends on the other, the data flow graph would determine
 358 -- that the C compiler from the first compilation can be overlapped
 359 -- with the hsc compilation for the second file.
 360
 361 data IntermediateFileType
 362   = Temporary
 363   | Persistent
 364   deriving (Eq, Show)
 365
 366 genPipeline
 367    :: GhcMode            -- when to stop
 368    -> String             -- "stop after" flag (for error messages)
 369    -> Bool               -- True => output is persistent
 370    -> HscLang            -- preferred output language for hsc
 371    -> (FilePath, String) -- original filename & its suffix
 372    -> IO [              -- list of phases to run for this file
 373              (Phase,
 374               IntermediateFileType,  -- keep the output from this phase?
 375               String)                -- output file suffix
 376          ]
 377
 378 genPipeline todo stop_flag persistent_output lang (filename,suffix)
 379  = do
 380    split      <- readIORef v_Split_object_files
 381    mangle     <- readIORef v_Do_asm_mangling
 382    keep_hc    <- readIORef v_Keep_hc_files
 383 #ifdef ILX
 384    keep_il    <- readIORef v_Keep_il_files
 385    keep_ilx   <- readIORef v_Keep_ilx_files
 386 #endif
 387    keep_raw_s <- readIORef v_Keep_raw_s_files
 388    keep_s     <- readIORef v_Keep_s_files
 389    osuf       <- readIORef v_Object_suf
 390    hcsuf      <- readIORef v_HC_suf
 391
 392    let
 393    ----------- -----  ----   ---   --   --  -  -  -
 394     start = startPhase suffix
 395
 396       -- special case for mkdependHS: .hspp files go through MkDependHS
 397     start_phase | todo == DoMkDependHS && start == Hsc  = MkDependHS
 398                 | otherwise = start
 399
 400     haskellish = haskellish_suffix suffix
 401     cish = cish_suffix suffix
 402
 403        -- for a .hc file we need to force lang to HscC
 404     real_lang | start_phase == HCc || start_phase == Mangle = HscC
 405               | otherwise                                   = lang
 406
 407    let
 408    ----------- -----  ----   ---   --   --  -  -  -
 409     pipeline = preprocess ++ compile
 410
 411     preprocess
 412         | haskellish = [ Unlit, Cpp, HsPp ]
 413         | otherwise  = [ ]
 414
 415     compile
 416       | todo == DoMkDependHS = [ MkDependHS ]
 417
 418       | cish = [ Cc, As ]
 419
 420       | haskellish =
 421        case real_lang of
 422         HscC    | split && mangle -> [ Hsc, HCc, Mangle, SplitMangle, SplitAs ]
 423                 | mangle          -> [ Hsc, HCc, Mangle, As ]
 424                 | split           -> not_valid
 425                 | otherwise       -> [ Hsc, HCc, As ]
 426
 427         HscAsm  | split           -> [ Hsc, SplitMangle, SplitAs ]
 428                 | otherwise       -> [ Hsc, As ]
 429
 430         HscJava | split           -> not_valid
 431                 | otherwise       -> error "not implemented: compiling via Java"
 432 #ifdef ILX
 433         HscILX  | split           -> not_valid
 434                 | otherwise       -> [ Hsc, Ilx2Il, Ilasm ]
 435 #endif
 436         HscNothing                -> [ Hsc, HCc ] -- HCc is a dummy stop phase
 437
 438       | otherwise = [ ]  -- just pass this file through to the linker
 439
 440         -- ToDo: this is somewhat cryptic
 441     not_valid = throwDyn (UsageError ("invalid option combination"))
 442
 443     stop_phase = case todo of
 444                         StopBefore As | split -> SplitAs
 445 #ifdef ILX
 446                                       | real_lang == HscILX -> Ilasm
 447 #endif
 448                         StopBefore phase      -> phase
 449                         DoMkDependHS          -> Ln
 450                         DoLink                -> Ln
 451                         DoMkDLL               -> Ln
 452    ----------- -----  ----   ---   --   --  -  -  -
 453
 454         -- this shouldn't happen.
 455    when (start_phase /= Ln && start_phase `notElem` pipeline)
 456         (throwDyn (CmdLineError ("can't find starting phase for "
 457                                  ++ filename)))
 458         -- if we can't find the phase we're supposed to stop before,
 459         -- something has gone wrong.  This test carefully avoids the
 460         -- case where we aren't supposed to do any compilation, because the file
 461         -- is already in linkable form (for example).
 462 --   hPutStrLn stderr (show ((start_phase `elem` pipeline,stop_phase /= Ln,stop_phase `notElem` pipeline), start_phase, stop_phase, pipeline,todo))
 463 --   hFlush stderr
 464    when (start_phase `elem` pipeline &&
 465          (stop_phase /= Ln && stop_phase `notElem` pipeline))
 466         (do
 467           throwDyn (UsageError
 468                     ("flag `" ++ stop_flag
 469                      ++ "' is incompatible with source file `"
 470                      ++ filename ++ "'" ++ show pipeline ++ show stop_phase)))
 471    let
 472         -- .o and .hc suffixes can be overriden by command-line options:
 473       myPhaseInputExt HCc | Just s <- hcsuf = s
 474       myPhaseInputExt Ln    = osuf
 475       myPhaseInputExt other = phaseInputExt other
 476
 477       annotatePipeline
 478          :: [Phase]             -- raw pipeline
 479          -> Phase               -- phase to stop before
 480          -> [(Phase, IntermediateFileType, String{-file extension-})]
 481       annotatePipeline []     _    = []
 482       annotatePipeline (Ln:_) _    = []
 483       annotatePipeline (phase:next_phase:ps) stop =
 484           (phase, keep_this_output, myPhaseInputExt next_phase)
 485              : annotatePipeline (next_phase:ps) stop
 486           where
 487                 keep_this_output
 488                      | next_phase == stop
 489                      = if persistent_output then Persistent else Temporary
 490                      | otherwise
 491                      = case next_phase of
 492                              Ln -> Persistent
 493                              Mangle | keep_raw_s -> Persistent
 494                              As     | keep_s     -> Persistent
 495                              HCc    | keep_hc    -> Persistent
 496 #ifdef ILX
 497                              Ilx2Il | keep_ilx   -> Persistent
 498                              Ilasm  | keep_il    -> Persistent
 499 #endif
 500                              _other              -> Temporary
 501
 502         -- add information about output files to the pipeline
 503         -- the suffix on an output file is determined by the next phase
 504         -- in the pipeline, so we add linking to the end of the pipeline
 505         -- to force the output from the final phase to be a .o file.
 506
 507       annotated_pipeline = annotatePipeline (pipeline ++ [Ln]) stop_phase
 508
 509       phase_ne p (p1,_,_) = (p1 /= p)
 510    ----------- -----  ----   ---   --   --  -  -  -
 511
 512    return (
 513      takeWhile (phase_ne stop_phase ) $
 514      dropWhile (phase_ne start_phase) $
 515      annotated_pipeline
 516     )
 517
 518
 519 runPipeline
 520   :: [ (Phase, IntermediateFileType, String) ] -- phases to run
 521   -> (String,String)            -- input file
 522   -> Bool                       -- doing linking afterward?
 523   -> Bool                       -- take into account -o when generating output?
 524   -> IO (String, String)        -- return final filename
 525
 526 runPipeline pipeline (input_fn,suffix) do_linking use_ofile
 527   = pipeLoop pipeline (input_fn,suffix) do_linking use_ofile basename suffix
 528   where (basename, _) = splitFilename input_fn
 529
 530 pipeLoop [] input_fn _ _ _ _ = return input_fn
 531 pipeLoop (all_phases@((phase, keep, o_suffix):phases))
 532         (input_fn,real_suff) do_linking use_ofile orig_basename orig_suffix
 533   = do
 534
 535      output_fn <- outputFileName (null phases) keep o_suffix
 536
 537      mbCarryOn <- run_phase phase orig_basename orig_suffix
 538                             input_fn output_fn
 539         -- sometimes we bail out early, eg. when the compiler's recompilation
 540         -- checker has determined that recompilation isn't necessary.
 541      case mbCarryOn of
 542        Nothing -> do
 543               let (_,keep,final_suffix) = last all_phases
 544               ofile <- outputFileName True keep final_suffix
 545               return (ofile, final_suffix)
 546           -- carry on ...
 547        Just fn -> do
 548                 {-
 549                   Check to see whether we've reached the end of the
 550                   pipeline, but did so with an ineffective last stage.
 551                   (i.e., it returned the input_fn as the output filename).
 552
 553                   If we did and the output is persistent, copy the contents
 554                   of input_fn into the file where the pipeline's output is
 555                   expected to end up.
 556                 -}
 557               atEnd <- finalStage (null phases)
 558               when (atEnd && fn == input_fn)
 559                    (copy "Saving away compilation pipeline's output"
 560                          input_fn
 561                          output_fn)
 562               {-
 563                Notice that in order to keep the invariant that we can
 564                determine a compilation pipeline's 'start phase' just
 565                by looking at the input filename, the input filename
 566                to the next stage/phase is associated here with the suffix
 567                of the output file, *even* if it does not have that
 568                suffix in reality.
 569
 570                Why is this important? Because we may run a compilation
 571                pipeline in stages (cf. Main.main.compileFile's two stages),
 572                so when generating the next stage we need to be precise
 573                about what kind of file (=> suffix) is given as input.
 574
 575                [Not having to generate a pipeline in stages seems like
 576                 the right way to go, but I've punted on this for now --sof]
 577
 578               -}
 579               pipeLoop phases (fn, o_suffix) do_linking use_ofile
 580                         orig_basename orig_suffix
 581   where
 582      finalStage lastPhase = do
 583        o_file <- readIORef v_Output_file
 584        return (lastPhase && not do_linking && use_ofile && isJust o_file)
 585
 586      outputFileName last_phase keep suffix
 587         = do o_file <- readIORef v_Output_file
 588              atEnd  <- finalStage last_phase
 589              if atEnd
 590                then case o_file of
 591                        Just s  -> return s
 592                        Nothing -> error "outputFileName"
 593                else if keep == Persistent
 594                            then odir_ify (orig_basename ++ '.':suffix)
 595                            else newTempName suffix
 596
 597 run_phase :: Phase
 598           -> String                -- basename of original input source
 599           -> String                -- its extension
 600           -> FilePath              -- name of file which contains the input to this phase.
 601           -> FilePath              -- where to stick the result.
 602           -> IO (Maybe FilePath)
 603                   -- Nothing => stop the compilation pipeline
 604                   -- Just fn => the result of this phase can be found in 'fn'
 605                   --            (this can either be 'input_fn' or 'output_fn').
 606 -------------------------------------------------------------------------------
 607 -- Unlit phase
 608
 609 run_phase Unlit _basename _suff input_fn output_fn
 610   = do unlit_flags <- getOpts opt_L
 611        -- The -h option passes the file name for unlit to put in a #line directive
 612        SysTools.runUnlit (map SysTools.Option unlit_flags ++
 613                           [ SysTools.Option     "-h"
 614                           , SysTools.Option     input_fn
 615                           , SysTools.FileOption "" input_fn
 616                           , SysTools.FileOption "" output_fn
 617                           ])
 618        return (Just output_fn)
 619
 620 -------------------------------------------------------------------------------
 621 -- Cpp phase
 622
 623 run_phase Cpp basename suff input_fn output_fn
 624   = do src_opts <- getOptionsFromSource input_fn
 625        unhandled_flags <- processArgs dynamic_flags src_opts []
 626        checkProcessArgsResult unhandled_flags basename suff
 627
 628        do_cpp <- dynFlag cppFlag
 629        if not do_cpp then
 630            -- no need to preprocess CPP, just pass input file along
 631            -- to the next phase of the pipeline.
 632           return (Just input_fn)
 633         else do
 634             hscpp_opts      <- getOpts opt_P
 635             hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
 636
 637             cmdline_include_paths <- readIORef v_Include_paths
 638             pkg_include_dirs <- getPackageIncludePath
 639             let include_paths = foldr (\ x xs -> "-I" : x : xs) []
 640                                   (cmdline_include_paths ++ pkg_include_dirs)
 641
 642             verb <- getVerbFlag
 643             (md_c_flags, _) <- machdepCCOpts
 644
 645             SysTools.runCpp ([SysTools.Option verb]
 646                             ++ map SysTools.Option include_paths
 647                             ++ map SysTools.Option hs_src_cpp_opts
 648                             ++ map SysTools.Option hscpp_opts
 649                             ++ map SysTools.Option md_c_flags
 650                             ++ [ SysTools.Option     "-x"
 651                                , SysTools.Option     "c"
 652                                , SysTools.Option     input_fn
 653         -- We hackily use Option instead of FileOption here, so that the file
 654         -- name is not back-slashed on Windows.  cpp is capable of
 655         -- dealing with / in filenames, so it works fine.  Furthermore
 656         -- if we put in backslashes, cpp outputs #line directives
 657         -- with *double* backslashes.   And that in turn means that
 658         -- our error messages get double backslashes in them.
 659         -- In due course we should arrange that the lexer deals
 660         -- with these \\ escapes properly.
 661                                , SysTools.Option     "-o"
 662                                , SysTools.FileOption "" output_fn
 663                                ])
 664             return (Just output_fn)
 665
 666 -------------------------------------------------------------------------------
 667 -- HsPp phase
 668
 669 run_phase HsPp basename suff input_fn output_fn
 670   = do let orig_fn = basename ++ '.':suff
 671        do_pp   <- dynFlag ppFlag
 672        if not do_pp then
 673            -- no need to preprocess, just pass input file along
 674            -- to the next phase of the pipeline.
 675           return (Just input_fn)
 676         else do
 677             hspp_opts      <- getOpts opt_F
 678             hs_src_pp_opts <- readIORef v_Hs_source_pp_opts
 679             SysTools.runPp ( [ SysTools.Option     orig_fn
 680                              , SysTools.Option     input_fn
 681                              , SysTools.FileOption "" output_fn
 682                              ] ++
 683                              map SysTools.Option hs_src_pp_opts ++
 684                              map SysTools.Option hspp_opts
 685                            )
 686             return (Just output_fn)
 687
 688 -----------------------------------------------------------------------------
 689 -- MkDependHS phase
 690
 691 run_phase MkDependHS basename suff input_fn output_fn
 692  = do src <- readFile input_fn
 693       let (import_sources, import_normals, _) = getImports src
 694       let orig_fn = basename ++ '.':suff
 695       deps_sources <- mapM (findDependency True  orig_fn) import_sources
 696       deps_normals <- mapM (findDependency False orig_fn) import_normals
 697       let deps = deps_sources ++ deps_normals
 698
 699       osuf <- readIORef v_Object_suf
 700
 701       extra_suffixes <- readIORef v_Dep_suffixes
 702       let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
 703           ofiles = map (\suf -> basename ++ '.':suf) suffixes
 704
 705       objs <- mapM odir_ify ofiles
 706
 707         -- Handle for file that accumulates dependencies
 708       hdl <- readIORef v_Dep_tmp_hdl
 709
 710         -- std dependency of the object(s) on the source file
 711       hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
 712                      escapeSpaces (basename ++ '.':suff))
 713
 714       let genDep (dep, False {- not an hi file -}) =
 715              hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
 716                             escapeSpaces dep)
 717           genDep (dep, True  {- is an hi file -}) = do
 718              hisuf <- readIORef v_Hi_suf
 719              let dep_base = remove_suffix '.' dep
 720                  deps = (dep_base ++ hisuf)
 721                         : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
 722                   -- length objs should be == length deps
 723              sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps)
 724
 725       sequence_ (map genDep [ d | Just d <- deps ])
 726       return (Just output_fn)
 727
 728 -- add the lines to dep_makefile:
 729            -- always:
 730                    -- this.o : this.hs
 731
 732            -- if the dependency is on something other than a .hi file:
 733                    -- this.o this.p_o ... : dep
 734            -- otherwise
 735                    -- if the import is {-# SOURCE #-}
 736                            -- this.o this.p_o ... : dep.hi-boot[-$vers]
 737
 738                    -- else
 739                            -- this.o ...   : dep.hi
 740                            -- this.p_o ... : dep.p_hi
 741                            -- ...
 742
 743            -- (where .o is $osuf, and the other suffixes come from
 744            -- the cmdline -s options).
 745
 746
 747 -----------------------------------------------------------------------------
 748 -- Hsc phase
 749
 750 -- Compilation of a single module, in "legacy" mode (_not_ under
 751 -- the direction of the compilation manager).
 752 run_phase Hsc basename suff input_fn output_fn
 753   = do
 754
 755   -- we add the current directory (i.e. the directory in which
 756   -- the .hs files resides) to the import path, since this is
 757   -- what gcc does, and it's probably what you want.
 758         let current_dir = directoryOf basename
 759
 760         paths <- readIORef v_Include_paths
 761         writeIORef v_Include_paths (current_dir : paths)
 762
 763   -- figure out which header files to #include in a generated .hc file
 764         c_includes <- getPackageCIncludes
 765         cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
 766
 767         let cc_injects = unlines (map mk_include
 768                                  (c_includes ++ reverse cmdline_includes))
 769             mk_include h_file =
 770                 case h_file of
 771                    '"':_{-"-} -> "#include "++h_file
 772                    '<':_      -> "#include "++h_file
 773                    _          -> "#include \""++h_file++"\""
 774
 775         writeIORef v_HCHeader cc_injects
 776
 777   -- gather the imports and module name
 778         (srcimps,imps,mod_name) <-
 779             if extcoreish_suffix suff
 780              then do
 781                -- no explicit imports in ExtCore input.
 782                m <- getCoreModuleName input_fn
 783                return ([], [], mkModuleName m)
 784              else
 785                getImportsFromFile input_fn
 786
 787   -- build a ModLocation to pass to hscMain.
 788         let (path,file) = splitFilenameDir basename
 789         (mod, location') <- mkHomeModLocation mod_name True path file suff
 790
 791   -- take -ohi into account if present
 792         ohi <- readIORef v_Output_hi
 793         let location | Just fn <- ohi = location'{ ml_hi_file = fn }
 794                      | otherwise      = location'
 795
 796   -- figure out if the source has changed, for recompilation avoidance.
 797   -- only do this if we're eventually going to generate a .o file.
 798   -- (ToDo: do when generating .hc files too?)
 799   --
 800   -- Setting source_unchanged to True means that M.o seems
 801   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 802   -- changed (which the compiler itself figures out).
 803   -- Setting source_unchanged to False tells the compiler that M.o is out of
 804   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 805         do_recomp   <- readIORef v_Recomp
 806         todo        <- readIORef v_GhcMode
 807         expl_o_file <- readIORef v_Output_file
 808
 809         let o_file -- if the -o option is given and IT IS THE OBJECT FILE FOR
 810                    -- THIS COMPILATION, then use that to determine if the
 811                    -- source is unchanged.
 812                 | Just x <- expl_o_file, todo == StopBefore Ln  =  x
 813                 | otherwise = expectJust "source_unchanged" (ml_obj_file location)
 814
 815         source_unchanged <-
 816           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
 817              then return False
 818              else do t1 <- getModificationTime (basename ++ '.':suff)
 819                      o_file_exists <- doesFileExist o_file
 820                      if not o_file_exists
 821                         then return False       -- Need to recompile
 822                         else do t2 <- getModificationTime o_file
 823                                 if t2 > t1
 824                                   then return True
 825                                   else return False
 826
 827   -- get the DynFlags
 828         dyn_flags <- getDynFlags
 829
 830         let dyn_flags' = dyn_flags { hscOutName = output_fn,
 831                                      hscStubCOutName = basename ++ "_stub.c",
 832                                      hscStubHOutName = basename ++ "_stub.h",
 833                                      extCoreName = basename ++ ".hcr" }
 834             hsc_env = HscEnv { hsc_mode = OneShot,
 835                                hsc_dflags = dyn_flags',
 836                                hsc_HPT    = emptyHomePackageTable }
 837
 838
 839   -- run the compiler!
 840         pcs <- initPersistentCompilerState
 841         result <- hscMain hsc_env pcs mod
 842                           location{ ml_hspp_file=Just input_fn }
 843                           source_unchanged
 844                           False
 845                           Nothing        -- no iface
 846
 847         case result of {
 848
 849             HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
 850
 851             HscNoRecomp pcs details iface -> do { SysTools.touch "Touching object file" o_file
 852                                                 ; return Nothing } ;
 853
 854             HscRecomp pcs details iface stub_h_exists stub_c_exists
 855                       _maybe_interpreted_code -> do
 856
 857                             -- deal with stubs
 858                             maybe_stub_o <- compileStub dyn_flags' stub_c_exists
 859                             case maybe_stub_o of
 860                               Nothing -> return ()
 861                               Just stub_o -> add v_Ld_inputs stub_o
 862                             case hscLang dyn_flags of
 863                               HscNothing -> return Nothing
 864                               _ -> return (Just output_fn)
 865     }
 866
 867 -----------------------------------------------------------------------------
 868 -- Cc phase
 869
 870 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 871 -- way too many hacks, and I can't say I've ever used it anyway.
 872
 873 run_phase cc_phase basename suff input_fn output_fn
 874    | cc_phase == Cc || cc_phase == HCc
 875    = do cc_opts              <- getOpts opt_c
 876         cmdline_include_paths <- readIORef v_Include_paths
 877
 878         let hcc = cc_phase == HCc
 879
 880                 -- add package include paths even if we're just compiling
 881                 -- .c files; this is the Value Add(TM) that using
 882                 -- ghc instead of gcc gives you :)
 883         pkg_include_dirs <- getPackageIncludePath
 884         let include_paths = foldr (\ x xs -> "-I" : x : xs) []
 885                               (cmdline_include_paths ++ pkg_include_dirs)
 886
 887         mangle <- readIORef v_Do_asm_mangling
 888         (md_c_flags, md_regd_c_flags) <- machdepCCOpts
 889
 890         verb <- getVerbFlag
 891
 892         o2 <- readIORef v_minus_o2_for_C
 893         let opt_flag | o2        = "-O2"
 894                      | otherwise = "-O"
 895
 896         pkg_extra_cc_opts <- getPackageExtraCcOpts
 897
 898         split_objs <- readIORef v_Split_object_files
 899         let split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
 900                       | otherwise         = [ ]
 901
 902         excessPrecision <- readIORef v_Excess_precision
 903
 904         -- force the C compiler to interpret this file as C when
 905         -- compiling .hc files, by adding the -x c option.
 906         let langopt
 907                 | cc_phase == HCc = [ SysTools.Option "-x", SysTools.Option "c"]
 908                 | otherwise       = [ ]
 909
 910         SysTools.runCc (langopt ++
 911                         [ SysTools.FileOption "" input_fn
 912                         , SysTools.Option "-o"
 913                         , SysTools.FileOption "" output_fn
 914                         ]
 915                        ++ map SysTools.Option (
 916                           md_c_flags
 917                        ++ (if cc_phase == HCc && mangle
 918                              then md_regd_c_flags
 919                              else [])
 920                        ++ [ verb, "-S", "-Wimplicit", opt_flag ]
 921                        ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 922                        ++ cc_opts
 923                        ++ split_opt
 924                        ++ (if excessPrecision then [] else [ "-ffloat-store" ])
 925                        ++ include_paths
 926                        ++ pkg_extra_cc_opts
 927                        ))
 928         return (Just output_fn)
 929
 930         -- ToDo: postprocess the output from gcc
 931
 932 -----------------------------------------------------------------------------
 933 -- Mangle phase
 934
 935 run_phase Mangle _basename _suff input_fn output_fn
 936   = do mangler_opts <- getOpts opt_m
 937        machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM)
 938                        then do n_regs <- dynFlag stolen_x86_regs
 939                                return [ show n_regs ]
 940                        else return []
 941
 942        SysTools.runMangle (map SysTools.Option mangler_opts
 943                           ++ [ SysTools.FileOption "" input_fn
 944                              , SysTools.FileOption "" output_fn
 945                              ]
 946                           ++ map SysTools.Option machdep_opts)
 947        return (Just output_fn)
 948
 949 -----------------------------------------------------------------------------
 950 -- Splitting phase
 951
 952 run_phase SplitMangle _basename _suff input_fn output_fn
 953   = do  -- tmp_pfx is the prefix used for the split .s files
 954         -- We also use it as the file to contain the no. of split .s files (sigh)
 955         split_s_prefix <- SysTools.newTempName "split"
 956         let n_files_fn = split_s_prefix
 957
 958         SysTools.runSplit [ SysTools.FileOption "" input_fn
 959                           , SysTools.FileOption "" split_s_prefix
 960                           , SysTools.FileOption "" n_files_fn
 961                           ]
 962
 963         -- Save the number of split files for future references
 964         s <- readFile n_files_fn
 965         let n_files = read s :: Int
 966         writeIORef v_Split_info (split_s_prefix, n_files)
 967
 968         -- Remember to delete all these files
 969         addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
 970                         | n <- [1..n_files]]
 971
 972         return (Just output_fn)
 973
 974 -----------------------------------------------------------------------------
 975 -- As phase
 976
 977 run_phase As _basename _suff input_fn output_fn
 978   = do  as_opts               <- getOpts opt_a
 979         cmdline_include_paths <- readIORef v_Include_paths
 980
 981         SysTools.runAs (map SysTools.Option as_opts
 982                        ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
 983                        ++ [ SysTools.Option "-c"
 984                           , SysTools.FileOption "" input_fn
 985                           , SysTools.Option "-o"
 986                           , SysTools.FileOption "" output_fn
 987                           ])
 988         return (Just output_fn)
 989
 990 run_phase SplitAs basename _suff _input_fn output_fn
 991   = do  as_opts <- getOpts opt_a
 992
 993         (split_s_prefix, n) <- readIORef v_Split_info
 994
 995         odir <- readIORef v_Output_dir
 996         let real_odir = case odir of
 997                                 Nothing -> basename ++ "_split"
 998                                 Just d  -> d
 999
1000         let assemble_file n
1001               = do  let input_s  = split_s_prefix ++ "__" ++ show n ++ ".s"
1002                     let output_o = replaceFilenameDirectory
1003                                         (basename ++ "__" ++ show n ++ ".o")
1004                                          real_odir
1005                     real_o <- osuf_ify output_o
1006                     SysTools.runAs (map SysTools.Option as_opts ++
1007                                     [ SysTools.Option "-c"
1008                                     , SysTools.Option "-o"
1009                                     , SysTools.FileOption "" real_o
1010                                     , SysTools.FileOption "" input_s
1011                                     ])
1012
1013         mapM_ assemble_file [1..n]
1014         return (Just output_fn)
1015
1016 #ifdef ILX
1017 -----------------------------------------------------------------------------
1018 -- Ilx2Il phase
1019 -- Run ilx2il over the ILX output, getting an IL file
1020
1021 run_phase Ilx2Il _basename _suff input_fn output_fn
1022   = do  ilx2il_opts <- getOpts opt_I
1023         SysTools.runIlx2il (map SysTools.Option ilx2il_opts
1024                            ++ [ SysTools.Option "--no-add-suffix-to-assembly",
1025                                 SysTools.Option "mscorlib",
1026                                 SysTools.Option "-o",
1027                                 SysTools.FileOption "" output_fn,
1028                                 SysTools.FileOption "" input_fn ])
1029         return (Just output_fn)
1030
1031 -----------------------------------------------------------------------------
1032 -- Ilasm phase
1033 -- Run ilasm over the IL, getting a DLL
1034
1035 run_phase Ilasm _basename _suff input_fn output_fn
1036   = do  ilasm_opts <- getOpts opt_i
1037         SysTools.runIlasm (map SysTools.Option ilasm_opts
1038                            ++ [ SysTools.Option "/QUIET",
1039                                 SysTools.Option "/DLL",
1040                                 SysTools.FileOption "/OUT=" output_fn,
1041                                 SysTools.FileOption "" input_fn ])
1042         return (Just output_fn)
1043
1044 #endif -- ILX
1045
1046 -----------------------------------------------------------------------------
1047 -- MoveBinary sort-of-phase
1048 -- After having produced a binary, move it somewhere else and generate a
1049 -- wrapper script calling the binary. Currently, we need this only in
1050 -- a parallel way (i.e. in GUM), because PVM expects the binary in a
1051 -- central directory.
1052 -- This is called from staticLink below, after linking. I haven't made it
1053 -- a separate phase to minimise interfering with other modules, and
1054 -- we don't need the generality of a phase (MoveBinary is always
1055 -- done after linking and makes only sense in a parallel setup)   -- HWL
1056
1057 run_phase_MoveBinary input_fn
1058   = do
1059         sysMan   <- getSysMan
1060         pvm_root <- getEnv "PVM_ROOT"
1061         pvm_arch <- getEnv "PVM_ARCH"
1062         let
1063            pvm_executable_base = "=" ++ input_fn
1064            pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
1065         -- nuke old binary; maybe use configur'ed names for cp and rm?
1066         system ("rm -f " ++ pvm_executable)
1067         -- move the newly created binary into PVM land
1068         system ("cp -p " ++ input_fn ++ " " ++ pvm_executable)
1069         -- generate a wrapper script for running a parallel prg under PVM
1070         writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
1071         return True
1072
1073 -- generates a Perl skript starting a parallel prg under PVM
1074 mk_pvm_wrapper_script :: String -> String -> String -> String
1075 mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
1076  [
1077   "eval 'exec perl -S $0 ${1+\"$@\"}'",
1078   "  if $running_under_some_shell;",
1079   "# =!=!=!=!=!=!=!=!=!=!=!",
1080   "# This script is automatically generated: DO NOT EDIT!!!",
1081   "# Generated by Glasgow Haskell Compiler",
1082   "# ngoqvam choHbogh vaj' vIHoHnISbej !!!!",
1083   "#",
1084   "$pvm_executable      = '" ++ pvm_executable ++ "';",
1085   "$pvm_executable_base = '" ++ pvm_executable_base ++ "';",
1086   "$SysMan = '" ++ sysMan ++ "';",
1087   "",
1088   {- ToDo: add the magical shortcuts again iff we actually use them -- HWL
1089   "# first, some magical shortcuts to run "commands" on the binary",
1090   "# (which is hidden)",
1091   "if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {",
1092   "    local($cmd) = $1;",
1093   "    system("$cmd $pvm_executable");",
1094   "    exit(0); # all done",
1095   "}", -}
1096   "",
1097   "# Now, run the real binary; process the args first",
1098   "$ENV{'PE'} = $pvm_executable_base;", --  ++ pvm_executable_base,
1099   "$debug = '';",
1100   "$nprocessors = 0; # the default: as many PEs as machines in PVM config",
1101   "@nonPVM_args = ();",
1102   "$in_RTS_args = 0;",
1103   "",
1104   "args: while ($a = shift(@ARGV)) {",
1105   "    if ( $a eq '+RTS' ) {",
1106   "     $in_RTS_args = 1;",
1107   "    } elsif ( $a eq '-RTS' ) {",
1108   "     $in_RTS_args = 0;",
1109   "    }",
1110   "    if ( $a eq '-d' && $in_RTS_args ) {",
1111   "     $debug = '-';",
1112   "    } elsif ( $a =~ /^-qN(\\d+)/ && $in_RTS_args ) {",
1113   "     $nprocessors = $1;",
1114   "    } elsif ( $a =~ /^-qp(\\d+)/ && $in_RTS_args ) {",
1115   "     $nprocessors = $1;",
1116   "    } else {",
1117   "     push(@nonPVM_args, $a);",
1118   "    }",
1119   "}",
1120   "",
1121   "local($return_val) = 0;",
1122   "# Start the parallel execution by calling SysMan",
1123   "system(\"$SysMan $debug $pvm_executable $nprocessors @nonPVM_args\");",
1124   "$return_val = $?;",
1125   "# ToDo: fix race condition moving files and flushing them!!",
1126   "system(\"cp $ENV{'HOME'}/$pvm_executable_base.???.gr .\") if -f \"$ENV{'HOME'}/$pvm_executable_base.002.gr\";",
1127   "exit($return_val);"
1128  ]
1129
1130 -----------------------------------------------------------------------------
1131 -- Complain about non-dynamic flags in OPTIONS pragmas
1132
1133 checkProcessArgsResult flags basename suff
1134   = do when (notNull flags) (throwDyn (ProgramError (
1135            basename ++ "." ++ suff
1136            ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t"
1137            ++ unwords flags)) (ExitFailure 1))
1138
1139 -----------------------------------------------------------------------------
1140 -- Static linking, of .o files
1141
1142 staticLink :: [String] -> IO ()
1143 staticLink o_files = do
1144     verb       <- getVerbFlag
1145     static     <- readIORef v_Static
1146     no_hs_main <- readIORef v_NoHsMain
1147
1148     o_file <- readIORef v_Output_file
1149     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
1150
1151     pkg_lib_paths <- getPackageLibraryPath
1152     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
1153
1154     lib_paths <- readIORef v_Library_paths
1155     let lib_path_opts = map ("-L"++) lib_paths
1156
1157     pkg_link_opts <- getPackageLinkOpts
1158
1159 #ifdef darwin_TARGET_OS
1160     pkg_framework_paths <- getPackageFrameworkPath
1161     let pkg_framework_path_opts = map ("-F"++) pkg_framework_paths
1162
1163     framework_paths <- readIORef v_Framework_paths
1164     let framework_path_opts = map ("-F"++) framework_paths
1165
1166     pkg_frameworks <- getPackageFrameworks
1167     let pkg_framework_opts = map ("-framework " ++) pkg_frameworks
1168
1169     frameworks <- readIORef v_Cmdline_frameworks
1170     let framework_opts = map ("-framework "++) (reverse frameworks)
1171          -- reverse because they're added in reverse order from the cmd line
1172 #endif
1173
1174         -- probably _stub.o files
1175     extra_ld_inputs <- readIORef v_Ld_inputs
1176
1177         -- opts from -optl-<blah> (including -l<blah> options)
1178     extra_ld_opts <- getStaticOpts v_Opt_l
1179
1180     [rts_pkg, std_pkg] <- getPackageDetails [rtsPackage, basePackage]
1181
1182     let extra_os = if static || no_hs_main
1183                    then []
1184                    else [ head (library_dirs rts_pkg) ++ "/Main.dll_o",
1185                           head (library_dirs std_pkg) ++ "/PrelMain.dll_o" ]
1186
1187     (md_c_flags, _) <- machdepCCOpts
1188     SysTools.runLink ( [ SysTools.Option verb
1189                        , SysTools.Option "-o"
1190                        , SysTools.FileOption "" output_fn
1191                        ]
1192                       ++ map SysTools.Option (
1193                          md_c_flags
1194                       ++ o_files
1195                       ++ extra_os
1196                       ++ extra_ld_inputs
1197                       ++ lib_path_opts
1198                       ++ extra_ld_opts
1199 #ifdef darwin_TARGET_OS
1200                       ++ framework_path_opts
1201                       ++ framework_opts
1202 #endif
1203                       ++ pkg_lib_path_opts
1204                       ++ pkg_link_opts
1205 #ifdef darwin_TARGET_OS
1206                       ++ pkg_framework_path_opts
1207                       ++ pkg_framework_opts
1208 #endif
1209                       ++ if static && not no_hs_main then
1210                             [ "-u", prefixUnderscore "Main_zdmain_closure"]
1211                          else []))
1212
1213     -- parallel only: move binary to another dir -- HWL
1214     ways_ <- readIORef v_Ways
1215     when (WayPar `elem` ways_)
1216          (do success <- run_phase_MoveBinary output_fn
1217              if success then return ()
1218                         else throwDyn (InstallationError ("cannot move binary to PVM dir")))
1219
1220 -----------------------------------------------------------------------------
1221 -- Making a DLL (only for Win32)
1222
1223 doMkDLL :: [String] -> IO ()
1224 doMkDLL o_files = do
1225     verb       <- getVerbFlag
1226     static     <- readIORef v_Static
1227     no_hs_main <- readIORef v_NoHsMain
1228
1229     o_file <- readIORef v_Output_file
1230     let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
1231
1232     pkg_lib_paths <- getPackageLibraryPath
1233     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
1234
1235     lib_paths <- readIORef v_Library_paths
1236     let lib_path_opts = map ("-L"++) lib_paths
1237
1238     pkg_link_opts <- getPackageLinkOpts
1239
1240         -- probably _stub.o files
1241     extra_ld_inputs <- readIORef v_Ld_inputs
1242
1243         -- opts from -optdll-<blah>
1244     extra_ld_opts <- getStaticOpts v_Opt_dll
1245
1246     [rts_pkg, std_pkg] <- getPackageDetails [rtsPackage, basePackage]
1247
1248     let extra_os = if static || no_hs_main
1249                    then []
1250                    else [ head (library_dirs rts_pkg) ++ "/Main.dll_o",
1251                           head (library_dirs std_pkg) ++ "/PrelMain.dll_o" ]
1252
1253     (md_c_flags, _) <- machdepCCOpts
1254     SysTools.runMkDLL
1255          ([ SysTools.Option verb
1256           , SysTools.Option "-o"
1257           , SysTools.FileOption "" output_fn
1258           ]
1259          ++ map SysTools.Option (
1260             md_c_flags
1261          ++ o_files
1262          ++ extra_os
1263          ++ [ "--target=i386-mingw32" ]
1264          ++ extra_ld_inputs
1265          ++ lib_path_opts
1266          ++ extra_ld_opts
1267          ++ pkg_lib_path_opts
1268          ++ pkg_link_opts
1269          ++ (if "--def" `elem` (concatMap words extra_ld_opts)
1270                then [ "" ]
1271                else [ "--export-all" ])
1272         ))