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