ghc/compiler/main/DriverPipeline.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverPipeline.hs,v 1.3 2000/10/16 15:16:59 simonmar Exp $
   3 --
   4 -- GHC Driver
   5 --
   6 -- (c) Simon Marlow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module DriverPipeline (
  11    GhcMode(..), getGhcMode, v_GhcMode,
  12    genPipeline, runPipeline,
  13    preprocess,
  14    doLink,
  15   ) where
  16
  17 #include "HsVersions.h"
  18
  19 import DriverState
  20 import DriverUtil
  21 import DriverMkDepend
  22 import DriverFlags
  23 import TmpFiles
  24 import Config
  25 import Util
  26 import CmdLineOpts
  27 import Panic
  28
  29 import IOExts
  30 import Posix
  31 import Exception
  32
  33 import IO
  34 import Monad
  35 import Maybe
  36
  37 -----------------------------------------------------------------------------
  38 -- GHC modes of operation
  39
  40 data GhcMode
  41   = DoMkDependHS                        -- ghc -M
  42   | DoMkDLL                             -- ghc -mk-dll
  43   | StopBefore Phase                    -- ghc -E | -C | -S | -c
  44   | DoMake                              -- ghc --make
  45   | DoInteractive                       -- ghc --interactive
  46   | DoLink                              -- [ the default ]
  47   deriving (Eq)
  48
  49 GLOBAL_VAR(v_GhcMode, error "todo", GhcMode)
  50
  51 modeFlag :: String -> Maybe GhcMode
  52 modeFlag "-M"            = Just $ DoMkDependHS
  53 modeFlag "-E"            = Just $ StopBefore Hsc
  54 modeFlag "-C"            = Just $ StopBefore HCc
  55 modeFlag "-S"            = Just $ StopBefore As
  56 modeFlag "-c"            = Just $ StopBefore Ln
  57 modeFlag "--make"        = Just $ DoMake
  58 modeFlag "--interactive" = Just $ DoInteractive
  59 modeFlag _               = Nothing
  60
  61 getGhcMode :: [String]
  62          -> IO ( [String]   -- rest of command line
  63                , GhcMode
  64                , String     -- "GhcMode" flag
  65                )
  66 getGhcMode flags
  67   = case my_partition modeFlag flags of
  68         ([]   , rest) -> return (rest, DoLink,  "") -- default is to do linking
  69         ([(flag,one)], rest) -> return (rest, one, flag)
  70         (_    , _   ) ->
  71           throwDyn (OtherError
  72                 "only one of the flags -M, -E, -C, -S, -c, --make, --interactive is allowed")
  73
  74 -----------------------------------------------------------------------------
  75 -- genPipeline
  76 --
  77 -- Herein is all the magic about which phases to run in which order, whether
  78 -- the intermediate files should be in /tmp or in the current directory,
  79 -- what the suffix of the intermediate files should be, etc.
  80
  81 -- The following compilation pipeline algorithm is fairly hacky.  A
  82 -- better way to do this would be to express the whole comilation as a
  83 -- data flow DAG, where the nodes are the intermediate files and the
  84 -- edges are the compilation phases.  This framework would also work
  85 -- nicely if a haskell dependency generator was included in the
  86 -- driver.
  87
  88 -- It would also deal much more cleanly with compilation phases that
  89 -- generate multiple intermediates, (eg. hsc generates .hc, .hi, and
  90 -- possibly stub files), where some of the output files need to be
  91 -- processed further (eg. the stub files need to be compiled by the C
  92 -- compiler).
  93
  94 -- A cool thing to do would then be to execute the data flow graph
  95 -- concurrently, automatically taking advantage of extra processors on
  96 -- the host machine.  For example, when compiling two Haskell files
  97 -- where one depends on the other, the data flow graph would determine
  98 -- that the C compiler from the first comilation can be overlapped
  99 -- with the hsc comilation for the second file.
 100
 101 data IntermediateFileType
 102   = Temporary
 103   | Persistent
 104   deriving (Eq)
 105
 106 genPipeline
 107    :: GhcMode           -- when to stop
 108    -> String            -- "stop after" flag (for error messages)
 109    -> String            -- original filename
 110    -> IO [              -- list of phases to run for this file
 111              (Phase,
 112               IntermediateFileType,  -- keep the output from this phase?
 113               String)                -- output file suffix
 114          ]
 115
 116 genPipeline todo stop_flag filename
 117  = do
 118    split      <- readIORef split_object_files
 119    mangle     <- readIORef do_asm_mangling
 120    lang       <- readIORef hsc_lang
 121    keep_hc    <- readIORef keep_hc_files
 122    keep_raw_s <- readIORef keep_raw_s_files
 123    keep_s     <- readIORef keep_s_files
 124
 125    let
 126    ----------- -----  ----   ---   --   --  -  -  -
 127     (_basename, suffix) = splitFilename filename
 128
 129     start_phase = startPhase suffix
 130
 131     haskellish = haskellish_suffix suffix
 132     cish = cish_suffix suffix
 133
 134    -- for a .hc file, or if the -C flag is given, we need to force lang to HscC
 135     real_lang
 136         | suffix == "hc"  = HscC
 137         | todo == StopBefore HCc && lang /= HscC && haskellish = HscC
 138         | otherwise = lang
 139
 140    let
 141    ----------- -----  ----   ---   --   --  -  -  -
 142     pipeline
 143       | todo == DoMkDependHS = [ Unlit, Cpp, MkDependHS ]
 144
 145       | haskellish =
 146        case real_lang of
 147         HscC    | split && mangle -> [ Unlit, Cpp, Hsc, HCc, Mangle,
 148                                         SplitMangle, SplitAs ]
 149                 | mangle          -> [ Unlit, Cpp, Hsc, HCc, Mangle, As ]
 150                 | split           -> not_valid
 151                 | otherwise       -> [ Unlit, Cpp, Hsc, HCc, As ]
 152
 153         HscAsm  | split           -> [ Unlit, Cpp, Hsc, SplitMangle, SplitAs ]
 154                 | otherwise       -> [ Unlit, Cpp, Hsc, As ]
 155
 156         HscJava | split           -> not_valid
 157                 | otherwise       -> error "not implemented: compiling via Java"
 158
 159       | cish      = [ Cc, As ]
 160
 161       | otherwise = [ ]  -- just pass this file through to the linker
 162
 163         -- ToDo: this is somewhat cryptic
 164     not_valid = throwDyn (OtherError ("invalid option combination"))
 165    ----------- -----  ----   ---   --   --  -  -  -
 166
 167         -- this shouldn't happen.
 168    if start_phase /= Ln && start_phase `notElem` pipeline
 169         then throwDyn (OtherError ("can't find starting phase for "
 170                                     ++ filename))
 171         else do
 172
 173         -- if we can't find the phase we're supposed to stop before,
 174         -- something has gone wrong.
 175    case todo of
 176         StopBefore phase ->
 177            when (phase /= Ln
 178                  && phase `notElem` pipeline
 179                  && not (phase == As && SplitAs `elem` pipeline)) $
 180               throwDyn (OtherError
 181                 ("flag " ++ stop_flag
 182                  ++ " is incompatible with source file `" ++ filename ++ "'"))
 183         _ -> return ()
 184
 185    let
 186    ----------- -----  ----   ---   --   --  -  -  -
 187       annotatePipeline
 188          :: [Phase]             -- raw pipeline
 189          -> Phase               -- phase to stop before
 190          -> [(Phase, IntermediateFileType, String{-file extension-})]
 191       annotatePipeline []     _    = []
 192       annotatePipeline (Ln:_) _    = []
 193       annotatePipeline (phase:next_phase:ps) stop =
 194           (phase, keep_this_output, phaseInputExt next_phase)
 195              : annotatePipeline (next_phase:ps) stop
 196           where
 197                 keep_this_output
 198                      | next_phase == stop = Persistent
 199                      | otherwise =
 200                         case next_phase of
 201                              Ln -> Persistent
 202                              Mangle | keep_raw_s -> Persistent
 203                              As     | keep_s     -> Persistent
 204                              HCc    | keep_hc    -> Persistent
 205                              _other              -> Temporary
 206
 207         -- add information about output files to the pipeline
 208         -- the suffix on an output file is determined by the next phase
 209         -- in the pipeline, so we add linking to the end of the pipeline
 210         -- to force the output from the final phase to be a .o file.
 211       stop_phase = case todo of StopBefore phase -> phase
 212                                 DoMkDependHS     -> Ln
 213                                 DoLink           -> Ln
 214       annotated_pipeline = annotatePipeline (pipeline ++ [ Ln ]) stop_phase
 215
 216       phase_ne p (p1,_,_) = (p1 /= p)
 217    ----------- -----  ----   ---   --   --  -  -  -
 218
 219    return $
 220      dropWhile (phase_ne start_phase) .
 221         foldr (\p ps -> if phase_ne stop_phase p then p:ps else [])  []
 222                 $ annotated_pipeline
 223
 224
 225 runPipeline
 226   :: [ (Phase, IntermediateFileType, String) ] -- phases to run
 227   -> String                     -- input file
 228   -> Bool                       -- doing linking afterward?
 229   -> Bool                       -- take into account -o when generating output?
 230   -> IO String                  -- return final filename
 231
 232 runPipeline pipeline input_fn do_linking use_ofile
 233   = pipeLoop pipeline input_fn do_linking use_ofile basename suffix
 234   where (basename, suffix) = splitFilename input_fn
 235
 236 pipeLoop [] input_fn _ _ _ _ = return input_fn
 237 pipeLoop ((phase, keep, o_suffix):phases)
 238         input_fn do_linking use_ofile orig_basename orig_suffix
 239   = do
 240
 241      output_fn <- outputFileName (null phases) keep o_suffix
 242
 243      carry_on <- run_phase phase orig_basename orig_suffix input_fn output_fn
 244         -- sometimes we bail out early, eg. when the compiler's recompilation
 245         -- checker has determined that recompilation isn't necessary.
 246      if not carry_on
 247         then do let (_,keep,final_suffix) = last phases
 248                 ofile <- outputFileName True keep final_suffix
 249                 return ofile
 250         else do -- carry on ...
 251
 252         -- sadly, ghc -E is supposed to write the file to stdout.  We
 253         -- generate <file>.cpp, so we also have to cat the file here.
 254      when (null phases && phase == Cpp) $
 255         run_something "Dump pre-processed file to stdout"
 256                       ("cat " ++ output_fn)
 257
 258      pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
 259
 260   where
 261      outputFileName last_phase keep suffix
 262         = do o_file <- readIORef output_file
 263              if last_phase && not do_linking && use_ofile && isJust o_file
 264                then case o_file of
 265                        Just s  -> return s
 266                        Nothing -> error "outputFileName"
 267                else if keep == Persistent
 268                            then do f <- odir_ify (orig_basename ++ '.':suffix)
 269                                    osuf_ify f
 270                            else newTempName suffix
 271
 272 -------------------------------------------------------------------------------
 273 -- Unlit phase
 274
 275 run_phase Unlit _basename _suff input_fn output_fn
 276   = do unlit <- readIORef pgm_L
 277        unlit_flags <- getOpts opt_L
 278        run_something "Literate pre-processor"
 279           ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
 280            ++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
 281        return True
 282
 283 -------------------------------------------------------------------------------
 284 -- Cpp phase
 285
 286 run_phase Cpp _basename _suff input_fn output_fn
 287   = do src_opts <- getOptionsFromSource input_fn
 288         -- ToDo: this is *wrong* if we're processing more than one file:
 289         -- the OPTIONS will persist through the subsequent compilations.
 290        _ <- processArgs dynamic_flags src_opts []
 291
 292        do_cpp <- readState cpp_flag
 293        if do_cpp
 294           then do
 295             cpp <- readIORef pgm_P
 296             hscpp_opts <- getOpts opt_P
 297             hs_src_cpp_opts <- readIORef hs_source_cpp_opts
 298
 299             cmdline_include_paths <- readIORef include_paths
 300             pkg_include_dirs <- getPackageIncludePath
 301             let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
 302                                                         ++ pkg_include_dirs)
 303
 304             verb <- is_verbose
 305             run_something "C pre-processor"
 306                 (unwords
 307                    (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
 308                      cpp, verb]
 309                     ++ include_paths
 310                     ++ hs_src_cpp_opts
 311                     ++ hscpp_opts
 312                     ++ [ "-x", "c", input_fn, ">>", output_fn ]
 313                    ))
 314           else do
 315             run_something "Ineffective C pre-processor"
 316                    ("echo '{-# LINE 1 \""  ++ input_fn ++ "\" -}' > "
 317                     ++ output_fn ++ " && cat " ++ input_fn
 318                     ++ " >> " ++ output_fn)
 319        return True
 320
 321 -----------------------------------------------------------------------------
 322 -- MkDependHS phase
 323
 324 run_phase MkDependHS basename suff input_fn _output_fn = do
 325    src <- readFile input_fn
 326    let imports = getImports src
 327
 328    deps <- mapM (findDependency basename) imports
 329
 330    osuf_opt <- readIORef output_suf
 331    let osuf = case osuf_opt of
 332                         Nothing -> "o"
 333                         Just s  -> s
 334
 335    extra_suffixes <- readIORef dep_suffixes
 336    let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
 337        ofiles = map (\suf -> basename ++ '.':suf) suffixes
 338
 339    objs <- mapM odir_ify ofiles
 340
 341    hdl <- readIORef dep_tmp_hdl
 342
 343         -- std dependeny of the object(s) on the source file
 344    hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
 345
 346    let genDep (dep, False {- not an hi file -}) =
 347           hPutStrLn hdl (unwords objs ++ " : " ++ dep)
 348        genDep (dep, True  {- is an hi file -}) = do
 349           hisuf <- readIORef hi_suf
 350           let dep_base = remove_suffix '.' dep
 351               deps = (dep_base ++ hisuf)
 352                      : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
 353                   -- length objs should be == length deps
 354           sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps)
 355
 356    mapM genDep [ d | Just d <- deps ]
 357
 358    return True
 359
 360 -- add the lines to dep_makefile:
 361            -- always:
 362                    -- this.o : this.hs
 363
 364            -- if the dependency is on something other than a .hi file:
 365                    -- this.o this.p_o ... : dep
 366            -- otherwise
 367                    -- if the import is {-# SOURCE #-}
 368                            -- this.o this.p_o ... : dep.hi-boot[-$vers]
 369
 370                    -- else
 371                            -- this.o ...   : dep.hi
 372                            -- this.p_o ... : dep.p_hi
 373                            -- ...
 374
 375            -- (where .o is $osuf, and the other suffixes come from
 376            -- the cmdline -s options).
 377
 378 -----------------------------------------------------------------------------
 379 -- Hsc phase
 380
 381 run_phase Hsc   basename suff input_fn output_fn
 382   = do
 383
 384   -- we add the current directory (i.e. the directory in which
 385   -- the .hs files resides) to the import path, since this is
 386   -- what gcc does, and it's probably what you want.
 387         let current_dir = getdir basename
 388
 389         paths <- readIORef include_paths
 390         writeIORef include_paths (current_dir : paths)
 391
 392   -- figure out where to put the .hi file
 393         ohi    <- readIORef output_hi
 394         hisuf  <- readIORef hi_suf
 395         let hifile = case ohi of
 396                            Nothing -> current_dir ++ {-ToDo: modname!!-}basename
 397                                         ++ hisuf
 398                            Just fn -> fn
 399
 400   -- figure out if the source has changed, for recompilation avoidance.
 401   -- only do this if we're eventually going to generate a .o file.
 402   -- (ToDo: do when generating .hc files too?)
 403   --
 404   -- Setting source_unchanged to "-fsource_unchanged" means that M.o seems
 405   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 406   -- changed (which the compiler itself figures out).
 407   -- Setting source_unchanged to "" tells the compiler that M.o is out of
 408   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 409         do_recomp <- readIORef recomp
 410         todo <- readIORef v_GhcMode
 411         o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
 412         source_unchanged <-
 413           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
 414              then return ""
 415              else do t1 <- getModificationTime (basename ++ '.':suff)
 416                      o_file_exists <- doesFileExist o_file
 417                      if not o_file_exists
 418                         then return ""  -- Need to recompile
 419                         else do t2 <- getModificationTime o_file
 420                                 if t2 > t1
 421                                   then return "-fsource-unchanged"
 422                                   else return ""
 423
 424    -- build a bogus ModSummary to pass to hscMain.
 425         let summary = ModSummary {
 426                         ms_loc = SourceOnly (error "no mod") input_fn,
 427                         ms_ppsource = Just (loc, error "no fingerprint"),
 428                         ms_imports = error "no imports"
 429                      }
 430
 431   -- run the compiler!
 432         result <- hscMain dyn_flags mod_summary
 433                                 Nothing{-no iface-}
 434                                 output_fn emptyUFM emptyPCS
 435
 436         case result of {
 437
 438             HscErrs pcs errs warns -> do
 439                 mapM (printSDoc PprForUser) warns
 440                 mapM (printSDoc PprForUser) errs
 441                 throwDyn (PhaseFailed "hsc" (ExitFailure 1));
 442
 443             HscOk details maybe_iface maybe_stub_h maybe_stub_c pcs warns -> do
 444
 445         mapM (printSDoc PprForUser) warns
 446
 447    -- generate the interface file
 448         case iface of
 449            Nothing -> -- compilation not required
 450              do run_something "Touching object file" ("touch " ++ o_file)
 451                 return False
 452
 453            Just iface ->
 454
 455   -- Deal with stubs
 456         let stub_h = basename ++ "_stub.h"
 457         let stub_c = basename ++ "_stub.c"
 458
 459   -- copy the .stub_h file into the current dir if necessary
 460         case maybe_stub_h of
 461            Nothing -> return ()
 462            Just tmp_stub_h -> do
 463                 run_something "Copy stub .h file"
 464                                 ("cp " ++ tmp_stub_h ++ ' ':stub_h)
 465
 466                         -- #include <..._stub.h> in .hc file
 467                 addCmdlineHCInclude tmp_stub_h  -- hack
 468
 469   -- copy the .stub_c file into the current dir, and compile it, if necessary
 470         case maybe_stub_c of
 471            Nothing -> return ()
 472            Just tmp_stub_c -> do  -- copy the _stub.c file into the current dir
 473                 run_something "Copy stub .c file"
 474                     (unwords [
 475                         "rm -f", stub_c, "&&",
 476                         "echo \'#include \""++stub_h++"\"\' >"++stub_c, " &&",
 477                         "cat", tmp_stub_c, ">> ", stub_c
 478                         ])
 479
 480                         -- compile the _stub.c file w/ gcc
 481                 pipeline <- genPipeline (StopBefore Ln) "" stub_c
 482                 runPipeline pipeline stub_c False{-no linking-} False{-no -o option-}
 483
 484                 add ld_inputs (basename++"_stub.o")
 485
 486         return True
 487
 488 -----------------------------------------------------------------------------
 489 -- Cc phase
 490
 491 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 492 -- way too many hacks, and I can't say I've ever used it anyway.
 493
 494 run_phase cc_phase _basename _suff input_fn output_fn
 495    | cc_phase == Cc || cc_phase == HCc
 496    = do cc <- readIORef pgm_c
 497         cc_opts <- (getOpts opt_c)
 498         cmdline_include_dirs <- readIORef include_paths
 499
 500         let hcc = cc_phase == HCc
 501
 502                 -- add package include paths even if we're just compiling
 503                 -- .c files; this is the Value Add(TM) that using
 504                 -- ghc instead of gcc gives you :)
 505         pkg_include_dirs <- getPackageIncludePath
 506         let include_paths = map (\p -> "-I"++p) (cmdline_include_dirs
 507                                                         ++ pkg_include_dirs)
 508
 509         c_includes <- getPackageCIncludes
 510         cmdline_includes <- readState cmdline_hc_includes -- -#include options
 511
 512         let cc_injects | hcc = unlines (map mk_include
 513                                         (c_includes ++ reverse cmdline_includes))
 514                        | otherwise = ""
 515             mk_include h_file =
 516                 case h_file of
 517                    '"':_{-"-} -> "#include "++h_file
 518                    '<':_      -> "#include "++h_file
 519                    _          -> "#include \""++h_file++"\""
 520
 521         cc_help <- newTempName "c"
 522         h <- openFile cc_help WriteMode
 523         hPutStr h cc_injects
 524         hPutStrLn h ("#include \"" ++ input_fn ++ "\"\n")
 525         hClose h
 526
 527         ccout <- newTempName "ccout"
 528
 529         mangle <- readIORef do_asm_mangling
 530         (md_c_flags, md_regd_c_flags) <- machdepCCOpts
 531
 532         verb <- is_verbose
 533
 534         o2 <- readIORef opt_minus_o2_for_C
 535         let opt_flag | o2        = "-O2"
 536                      | otherwise = "-O"
 537
 538         pkg_extra_cc_opts <- getPackageExtraCcOpts
 539
 540         excessPrecision <- readIORef excess_precision
 541
 542         run_something "C Compiler"
 543          (unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
 544                    ++ md_c_flags
 545                    ++ (if cc_phase == HCc && mangle
 546                          then md_regd_c_flags
 547                          else [])
 548                    ++ [ verb, "-S", "-Wimplicit", opt_flag ]
 549                    ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 550                    ++ cc_opts
 551 #ifdef mingw32_TARGET_OS
 552                    ++ [" -mno-cygwin"]
 553 #endif
 554                    ++ (if excessPrecision then [] else [ "-ffloat-store" ])
 555                    ++ include_paths
 556                    ++ pkg_extra_cc_opts
 557 --                 ++ [">", ccout]
 558                    ))
 559         return True
 560
 561         -- ToDo: postprocess the output from gcc
 562
 563 -----------------------------------------------------------------------------
 564 -- Mangle phase
 565
 566 run_phase Mangle _basename _suff input_fn output_fn
 567   = do mangler <- readIORef pgm_m
 568        mangler_opts <- getOpts opt_m
 569        machdep_opts <-
 570          if (prefixMatch "i386" cTARGETPLATFORM)
 571             then do n_regs <- readState stolen_x86_regs
 572                     return [ show n_regs ]
 573             else return []
 574        run_something "Assembly Mangler"
 575         (unwords (mangler :
 576                      mangler_opts
 577                   ++ [ input_fn, output_fn ]
 578                   ++ machdep_opts
 579                 ))
 580        return True
 581
 582 -----------------------------------------------------------------------------
 583 -- Splitting phase
 584
 585 run_phase SplitMangle _basename _suff input_fn _output_fn
 586   = do  splitter <- readIORef pgm_s
 587
 588         -- this is the prefix used for the split .s files
 589         tmp_pfx <- readIORef v_TmpDir
 590         x <- getProcessID
 591         let split_s_prefix = tmp_pfx ++ "/ghc" ++ show x
 592         writeIORef split_prefix split_s_prefix
 593         addFilesToClean [split_s_prefix ++ "__*"] -- d:-)
 594
 595         -- allocate a tmp file to put the no. of split .s files in (sigh)
 596         n_files <- newTempName "n_files"
 597
 598         run_something "Split Assembly File"
 599          (unwords [ splitter
 600                   , input_fn
 601                   , split_s_prefix
 602                   , n_files ]
 603          )
 604
 605         -- save the number of split files for future references
 606         s <- readFile n_files
 607         let n = read s :: Int
 608         writeIORef n_split_files n
 609         return True
 610
 611 -----------------------------------------------------------------------------
 612 -- As phase
 613
 614 run_phase As _basename _suff input_fn output_fn
 615   = do  as <- readIORef pgm_a
 616         as_opts <- getOpts opt_a
 617
 618         cmdline_include_paths <- readIORef include_paths
 619         let cmdline_include_flags = map (\p -> "-I"++p) cmdline_include_paths
 620         run_something "Assembler"
 621            (unwords (as : as_opts
 622                        ++ cmdline_include_flags
 623                        ++ [ "-c", input_fn, "-o",  output_fn ]
 624                     ))
 625         return True
 626
 627 run_phase SplitAs basename _suff _input_fn _output_fn
 628   = do  as <- readIORef pgm_a
 629         as_opts <- getOpts opt_a
 630
 631         split_s_prefix <- readIORef split_prefix
 632         n <- readIORef n_split_files
 633
 634         odir <- readIORef output_dir
 635         let real_odir = case odir of
 636                                 Nothing -> basename
 637                                 Just d  -> d
 638
 639         let assemble_file n = do
 640                     let input_s  = split_s_prefix ++ "__" ++ show n ++ ".s"
 641                     let output_o = newdir real_odir
 642                                         (basename ++ "__" ++ show n ++ ".o")
 643                     real_o <- osuf_ify output_o
 644                     run_something "Assembler"
 645                             (unwords (as : as_opts
 646                                       ++ [ "-c", "-o", real_o, input_s ]
 647                             ))
 648
 649         mapM_ assemble_file [1..n]
 650         return True
 651
 652 -----------------------------------------------------------------------------
 653 -- Linking
 654
 655 doLink :: [String] -> IO ()
 656 doLink o_files = do
 657     ln <- readIORef pgm_l
 658     verb <- is_verbose
 659     o_file <- readIORef output_file
 660     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 661
 662     pkg_lib_paths <- getPackageLibraryPath
 663     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 664
 665     lib_paths <- readIORef library_paths
 666     let lib_path_opts = map ("-L"++) lib_paths
 667
 668     pkg_libs <- getPackageLibraries
 669     let pkg_lib_opts = map (\lib -> "-l"++lib) pkg_libs
 670
 671     libs <- readIORef cmdline_libraries
 672     let lib_opts = map ("-l"++) (reverse libs)
 673          -- reverse because they're added in reverse order from the cmd line
 674
 675     pkg_extra_ld_opts <- getPackageExtraLdOpts
 676
 677         -- probably _stub.o files
 678     extra_ld_inputs <- readIORef ld_inputs
 679
 680         -- opts from -optl-<blah>
 681     extra_ld_opts <- getStaticOpts opt_l
 682
 683     run_something "Linker"
 684        (unwords
 685          ([ ln, verb, "-o", output_fn ]
 686          ++ o_files
 687          ++ extra_ld_inputs
 688          ++ lib_path_opts
 689          ++ lib_opts
 690          ++ pkg_lib_path_opts
 691          ++ pkg_lib_opts
 692          ++ pkg_extra_ld_opts
 693          ++ extra_ld_opts
 694         )
 695        )
 696
 697 -----------------------------------------------------------------------------
 698 -- Just preprocess a file, put the result in a temp. file (used by the
 699 -- compilation manager during the summary phase).
 700
 701 preprocess :: FilePath -> IO FilePath
 702 preprocess filename =
 703   ASSERT(haskellish_file filename)
 704   do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") filename
 705      runPipeline pipeline filename False{-no linking-} False{-no -o flag-}