ghc/compiler/main/DriverPipeline.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverPipeline.hs,v 1.20 2000/11/13 14:34:37 sewardj Exp $
   3 --
   4 -- GHC Driver
   5 --
   6 -- (c) Simon Marlow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module DriverPipeline (
  11
  12         -- interfaces for the batch-mode driver
  13    GhcMode(..), getGhcMode, v_GhcMode,
  14    genPipeline, runPipeline,
  15
  16         -- interfaces for the compilation manager (interpreted/batch-mode)
  17    preprocess, compile, CompResult(..),
  18
  19         -- batch-mode linking interface
  20    doLink
  21   ) where
  22
  23 #include "HsVersions.h"
  24
  25 import CmSummarise
  26 import CmLink
  27 import DriverState
  28 import DriverUtil
  29 import DriverMkDepend
  30 import DriverPhases
  31 import DriverFlags
  32 import HscMain
  33 import TmpFiles
  34 import HscTypes
  35 import Outputable
  36 import Module
  37 import CmdLineOpts
  38 import Config
  39 import Util
  40
  41 import Directory
  42 import System
  43 import IOExts
  44 import Exception
  45
  46 import IO
  47 import Monad
  48 import Maybe
  49
  50 -----------------------------------------------------------------------------
  51 -- GHC modes of operation
  52
  53 data GhcMode
  54   = DoMkDependHS                        -- ghc -M
  55   | DoMkDLL                             -- ghc -mk-dll
  56   | StopBefore Phase                    -- ghc -E | -C | -S | -c
  57   | DoMake                              -- ghc --make
  58   | DoInteractive                       -- ghc --interactive
  59   | DoLink                              -- [ the default ]
  60   deriving (Eq)
  61
  62 GLOBAL_VAR(v_GhcMode, error "todo", GhcMode)
  63
  64 modeFlag :: String -> Maybe GhcMode
  65 modeFlag "-M"            = Just $ DoMkDependHS
  66 modeFlag "-E"            = Just $ StopBefore Hsc
  67 modeFlag "-C"            = Just $ StopBefore HCc
  68 modeFlag "-S"            = Just $ StopBefore As
  69 modeFlag "-c"            = Just $ StopBefore Ln
  70 modeFlag "--make"        = Just $ DoMake
  71 modeFlag "--interactive" = Just $ DoInteractive
  72 modeFlag _               = Nothing
  73
  74 getGhcMode :: [String]
  75          -> IO ( [String]   -- rest of command line
  76                , GhcMode
  77                , String     -- "GhcMode" flag
  78                )
  79 getGhcMode flags
  80   = case my_partition modeFlag flags of
  81         ([]   , rest) -> return (rest, DoLink,  "") -- default is to do linking
  82         ([(flag,one)], rest) -> return (rest, one, flag)
  83         (_    , _   ) ->
  84           throwDyn (OtherError
  85                 "only one of the flags -M, -E, -C, -S, -c, --make, --interactive is allowed")
  86
  87 -----------------------------------------------------------------------------
  88 -- genPipeline
  89 --
  90 -- Herein is all the magic about which phases to run in which order, whether
  91 -- the intermediate files should be in /tmp or in the current directory,
  92 -- what the suffix of the intermediate files should be, etc.
  93
  94 -- The following compilation pipeline algorithm is fairly hacky.  A
  95 -- better way to do this would be to express the whole comilation as a
  96 -- data flow DAG, where the nodes are the intermediate files and the
  97 -- edges are the compilation phases.  This framework would also work
  98 -- nicely if a haskell dependency generator was included in the
  99 -- driver.
 100
 101 -- It would also deal much more cleanly with compilation phases that
 102 -- generate multiple intermediates, (eg. hsc generates .hc, .hi, and
 103 -- possibly stub files), where some of the output files need to be
 104 -- processed further (eg. the stub files need to be compiled by the C
 105 -- compiler).
 106
 107 -- A cool thing to do would then be to execute the data flow graph
 108 -- concurrently, automatically taking advantage of extra processors on
 109 -- the host machine.  For example, when compiling two Haskell files
 110 -- where one depends on the other, the data flow graph would determine
 111 -- that the C compiler from the first comilation can be overlapped
 112 -- with the hsc comilation for the second file.
 113
 114 data IntermediateFileType
 115   = Temporary
 116   | Persistent
 117   deriving (Eq)
 118
 119 genPipeline
 120    :: GhcMode           -- when to stop
 121    -> String            -- "stop after" flag (for error messages)
 122    -> Bool              -- True => output is persistent
 123    -> String            -- original filename
 124    -> IO [              -- list of phases to run for this file
 125              (Phase,
 126               IntermediateFileType,  -- keep the output from this phase?
 127               String)                -- output file suffix
 128          ]
 129
 130 genPipeline todo stop_flag persistent_output filename
 131  = do
 132    split      <- readIORef v_Split_object_files
 133    mangle     <- readIORef v_Do_asm_mangling
 134    lang       <- readIORef v_Hsc_Lang
 135    keep_hc    <- readIORef v_Keep_hc_files
 136    keep_raw_s <- readIORef v_Keep_raw_s_files
 137    keep_s     <- readIORef v_Keep_s_files
 138    osuf       <- readIORef v_Object_suf
 139
 140    let
 141    ----------- -----  ----   ---   --   --  -  -  -
 142     (_basename, suffix) = splitFilename filename
 143
 144     start_phase = startPhase suffix
 145
 146     haskellish = haskellish_suffix suffix
 147     cish = cish_suffix suffix
 148
 149    -- for a .hc file, or if the -C flag is given, we need to force lang to HscC
 150     real_lang | suffix == "hc"  = HscC
 151               | otherwise       = lang
 152
 153    let
 154    ----------- -----  ----   ---   --   --  -  -  -
 155     pipeline
 156       | todo == DoMkDependHS = [ Unlit, Cpp, MkDependHS ]
 157
 158       | haskellish =
 159        case real_lang of
 160         HscC    | split && mangle -> [ Unlit, Cpp, Hsc, HCc, Mangle,
 161                                         SplitMangle, SplitAs ]
 162                 | mangle          -> [ Unlit, Cpp, Hsc, HCc, Mangle, As ]
 163                 | split           -> not_valid
 164                 | otherwise       -> [ Unlit, Cpp, Hsc, HCc, As ]
 165
 166         HscAsm  | split           -> [ Unlit, Cpp, Hsc, SplitMangle, SplitAs ]
 167                 | otherwise       -> [ Unlit, Cpp, Hsc, As ]
 168
 169         HscJava | split           -> not_valid
 170                 | otherwise       -> error "not implemented: compiling via Java"
 171
 172       | cish      = [ Cc, As ]
 173
 174       | otherwise = [ ]  -- just pass this file through to the linker
 175
 176         -- ToDo: this is somewhat cryptic
 177     not_valid = throwDyn (OtherError ("invalid option combination"))
 178    ----------- -----  ----   ---   --   --  -  -  -
 179
 180         -- this shouldn't happen.
 181    if start_phase /= Ln && start_phase `notElem` pipeline
 182         then throwDyn (OtherError ("can't find starting phase for "
 183                                     ++ filename))
 184         else do
 185
 186         -- if we can't find the phase we're supposed to stop before,
 187         -- something has gone wrong.
 188    case todo of
 189         StopBefore phase ->
 190            when (phase /= Ln
 191                  && phase `notElem` pipeline
 192                  && not (phase == As && SplitAs `elem` pipeline)) $
 193               throwDyn (OtherError
 194                 ("flag " ++ stop_flag
 195                  ++ " is incompatible with source file `" ++ filename ++ "'"))
 196         _ -> return ()
 197
 198    let
 199    ----------- -----  ----   ---   --   --  -  -  -
 200       myPhaseInputExt Ln = case osuf of Nothing -> phaseInputExt Ln
 201                                         Just s  -> s
 202       myPhaseInputExt other = phaseInputExt other
 203
 204       annotatePipeline
 205          :: [Phase]             -- raw pipeline
 206          -> Phase               -- phase to stop before
 207          -> [(Phase, IntermediateFileType, String{-file extension-})]
 208       annotatePipeline []     _    = []
 209       annotatePipeline (Ln:_) _    = []
 210       annotatePipeline (phase:next_phase:ps) stop =
 211           (phase, keep_this_output, myPhaseInputExt next_phase)
 212              : annotatePipeline (next_phase:ps) stop
 213           where
 214                 keep_this_output
 215                      | next_phase == stop
 216                      = if persistent_output then Persistent else Temporary
 217                      | otherwise
 218                      = case next_phase of
 219                              Ln -> Persistent
 220                              Mangle | keep_raw_s -> Persistent
 221                              As     | keep_s     -> Persistent
 222                              HCc    | keep_hc    -> Persistent
 223                              _other              -> Temporary
 224
 225         -- add information about output files to the pipeline
 226         -- the suffix on an output file is determined by the next phase
 227         -- in the pipeline, so we add linking to the end of the pipeline
 228         -- to force the output from the final phase to be a .o file.
 229       stop_phase = case todo of StopBefore phase -> phase
 230                                 DoMkDependHS     -> Ln
 231                                 DoLink           -> Ln
 232       annotated_pipeline = annotatePipeline (pipeline ++ [ Ln ]) stop_phase
 233
 234       phase_ne p (p1,_,_) = (p1 /= p)
 235    ----------- -----  ----   ---   --   --  -  -  -
 236
 237    return $
 238      dropWhile (phase_ne start_phase) .
 239         foldr (\p ps -> if phase_ne stop_phase p then p:ps else [])  []
 240                 $ annotated_pipeline
 241
 242
 243 runPipeline
 244   :: [ (Phase, IntermediateFileType, String) ] -- phases to run
 245   -> String                     -- input file
 246   -> Bool                       -- doing linking afterward?
 247   -> Bool                       -- take into account -o when generating output?
 248   -> IO String                  -- return final filename
 249
 250 runPipeline pipeline input_fn do_linking use_ofile
 251   = pipeLoop pipeline input_fn do_linking use_ofile basename suffix
 252   where (basename, suffix) = splitFilename input_fn
 253
 254 pipeLoop [] input_fn _ _ _ _ = return input_fn
 255 pipeLoop ((phase, keep, o_suffix):phases)
 256         input_fn do_linking use_ofile orig_basename orig_suffix
 257   = do
 258
 259      output_fn <- outputFileName (null phases) keep o_suffix
 260
 261      carry_on <- run_phase phase orig_basename orig_suffix input_fn output_fn
 262         -- sometimes we bail out early, eg. when the compiler's recompilation
 263         -- checker has determined that recompilation isn't necessary.
 264      if not carry_on
 265         then do let (_,keep,final_suffix) = last phases
 266                 ofile <- outputFileName True keep final_suffix
 267                 return ofile
 268         else do -- carry on ...
 269
 270      pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
 271
 272   where
 273      outputFileName last_phase keep suffix
 274         = do o_file <- readIORef v_Output_file
 275              if last_phase && not do_linking && use_ofile && isJust o_file
 276                then case o_file of
 277                        Just s  -> return s
 278                        Nothing -> error "outputFileName"
 279                else if keep == Persistent
 280                            then odir_ify (orig_basename ++ '.':suffix)
 281                            else newTempName suffix
 282
 283 -------------------------------------------------------------------------------
 284 -- Unlit phase
 285
 286 run_phase Unlit _basename _suff input_fn output_fn
 287   = do unlit <- readIORef v_Pgm_L
 288        unlit_flags <- getOpts opt_L
 289        run_something "Literate pre-processor"
 290           ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
 291            ++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
 292        return True
 293
 294 -------------------------------------------------------------------------------
 295 -- Cpp phase
 296
 297 run_phase Cpp basename suff input_fn output_fn
 298   = do src_opts <- getOptionsFromSource input_fn
 299        unhandled_flags <- processArgs dynamic_flags src_opts []
 300
 301        when (not (null unhandled_flags))
 302             (throwDyn (OtherError (
 303                           basename ++ "." ++ suff
 304                           ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t"
 305                           ++ unwords unhandled_flags)) (ExitFailure 1))
 306
 307        do_cpp <- readState cpp_flag
 308        if do_cpp
 309           then do
 310             cpp <- readIORef v_Pgm_P
 311             hscpp_opts <- getOpts opt_P
 312             hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
 313
 314             cmdline_include_paths <- readIORef v_Include_paths
 315             pkg_include_dirs <- getPackageIncludePath
 316             let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
 317                                                         ++ pkg_include_dirs)
 318
 319             verb <- is_verbose
 320             run_something "C pre-processor"
 321                 (unwords
 322                    (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
 323                      cpp, verb]
 324                     ++ include_paths
 325                     ++ hs_src_cpp_opts
 326                     ++ hscpp_opts
 327                     ++ [ "-x", "c", input_fn, ">>", output_fn ]
 328                    ))
 329           else do
 330             run_something "Ineffective C pre-processor"
 331                    ("echo '{-# LINE 1 \""  ++ input_fn ++ "\" -}' > "
 332                     ++ output_fn ++ " && cat " ++ input_fn
 333                     ++ " >> " ++ output_fn)
 334        return True
 335
 336 -----------------------------------------------------------------------------
 337 -- MkDependHS phase
 338
 339 run_phase MkDependHS basename suff input_fn _output_fn = do
 340    src <- readFile input_fn
 341    let imports = getImports src
 342
 343    deps <- mapM (findDependency basename) imports
 344
 345    osuf_opt <- readIORef v_Object_suf
 346    let osuf = case osuf_opt of
 347                         Nothing -> phaseInputExt Ln
 348                         Just s  -> s
 349
 350    extra_suffixes <- readIORef v_Dep_suffixes
 351    let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
 352        ofiles = map (\suf -> basename ++ '.':suf) suffixes
 353
 354    objs <- mapM odir_ify ofiles
 355
 356    hdl <- readIORef v_Dep_tmp_hdl
 357
 358         -- std dependency of the object(s) on the source file
 359    hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
 360
 361    let genDep (dep, False {- not an hi file -}) =
 362           hPutStrLn hdl (unwords objs ++ " : " ++ dep)
 363        genDep (dep, True  {- is an hi file -}) = do
 364           hisuf <- readIORef v_Hi_suf
 365           let dep_base = remove_suffix '.' dep
 366               deps = (dep_base ++ hisuf)
 367                      : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
 368                   -- length objs should be == length deps
 369           sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps)
 370
 371    mapM genDep [ d | Just d <- deps ]
 372
 373    return True
 374
 375 -- add the lines to dep_makefile:
 376            -- always:
 377                    -- this.o : this.hs
 378
 379            -- if the dependency is on something other than a .hi file:
 380                    -- this.o this.p_o ... : dep
 381            -- otherwise
 382                    -- if the import is {-# SOURCE #-}
 383                            -- this.o this.p_o ... : dep.hi-boot[-$vers]
 384
 385                    -- else
 386                            -- this.o ...   : dep.hi
 387                            -- this.p_o ... : dep.p_hi
 388                            -- ...
 389
 390            -- (where .o is $osuf, and the other suffixes come from
 391            -- the cmdline -s options).
 392
 393 -----------------------------------------------------------------------------
 394 -- Hsc phase
 395
 396 -- Compilation of a single module, in "legacy" mode (_not_ under
 397 -- the direction of the compilation manager).
 398 run_phase Hsc basename suff input_fn output_fn
 399   = do
 400
 401   -- we add the current directory (i.e. the directory in which
 402   -- the .hs files resides) to the import path, since this is
 403   -- what gcc does, and it's probably what you want.
 404         let current_dir = getdir basename
 405
 406         paths <- readIORef v_Include_paths
 407         writeIORef v_Include_paths (current_dir : paths)
 408
 409   -- figure out where to put the .hi file
 410         ohi    <- readIORef v_Output_hi
 411         hisuf  <- readIORef v_Hi_suf
 412         let hifile = case ohi of
 413                            Nothing -> current_dir ++ "/" ++ basename
 414                                         ++ "." ++ hisuf
 415                            Just fn -> fn
 416
 417   -- figure out if the source has changed, for recompilation avoidance.
 418   -- only do this if we're eventually going to generate a .o file.
 419   -- (ToDo: do when generating .hc files too?)
 420   --
 421   -- Setting source_unchanged to True means that M.o seems
 422   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 423   -- changed (which the compiler itself figures out).
 424   -- Setting source_unchanged to False tells the compiler that M.o is out of
 425   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 426         do_recomp <- readIORef v_Recomp
 427         todo <- readIORef v_GhcMode
 428         o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
 429         source_unchanged <-
 430           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
 431              then return False
 432              else do t1 <- getModificationTime (basename ++ '.':suff)
 433                      o_file_exists <- doesFileExist o_file
 434                      if not o_file_exists
 435                         then return False       -- Need to recompile
 436                         else do t2 <- getModificationTime o_file
 437                                 if t2 > t1
 438                                   then return True
 439                                   else return False
 440
 441    -- build a ModuleLocation to pass to hscMain.
 442         let location = ModuleLocation {
 443                           ml_hs_file   = Nothing,
 444                           ml_hspp_file = Just input_fn,
 445                           ml_hi_file   = Just hifile,
 446                           ml_obj_file  = Just o_file
 447                        }
 448
 449   -- get the DynFlags
 450         dyn_flags <- readIORef v_DynFlags
 451
 452   -- run the compiler!
 453         pcs <- initPersistentCompilerState
 454         result <- hscMain dyn_flags{ hscOutName = output_fn }
 455                           source_unchanged
 456                           location
 457                           Nothing        -- no iface
 458                           emptyModuleEnv -- HomeSymbolTable
 459                           emptyModuleEnv -- HomeIfaceTable
 460                           pcs
 461
 462         case result of {
 463
 464             HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
 465
 466             HscOK details maybe_iface maybe_stub_h maybe_stub_c
 467                         _maybe_interpreted_code pcs -> do
 468
 469             -- deal with stubs
 470         maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
 471         case maybe_stub_o of
 472                 Nothing -> return ()
 473                 Just stub_o -> add v_Ld_inputs stub_o
 474
 475         let keep_going = case maybe_iface of Just _ -> True; Nothing -> False
 476         return keep_going
 477     }
 478
 479 -----------------------------------------------------------------------------
 480 -- Cc phase
 481
 482 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 483 -- way too many hacks, and I can't say I've ever used it anyway.
 484
 485 run_phase cc_phase _basename _suff input_fn output_fn
 486    | cc_phase == Cc || cc_phase == HCc
 487    = do cc <- readIORef v_Pgm_c
 488         cc_opts <- (getOpts opt_c)
 489         cmdline_include_dirs <- readIORef v_Include_paths
 490
 491         let hcc = cc_phase == HCc
 492
 493                 -- add package include paths even if we're just compiling
 494                 -- .c files; this is the Value Add(TM) that using
 495                 -- ghc instead of gcc gives you :)
 496         pkg_include_dirs <- getPackageIncludePath
 497         let include_paths = map (\p -> "-I"++p) (cmdline_include_dirs
 498                                                         ++ pkg_include_dirs)
 499
 500         c_includes <- getPackageCIncludes
 501         cmdline_includes <- readState cmdline_hc_includes -- -#include options
 502
 503         let cc_injects | hcc = unlines (map mk_include
 504                                         (c_includes ++ reverse cmdline_includes))
 505                        | otherwise = ""
 506             mk_include h_file =
 507                 case h_file of
 508                    '"':_{-"-} -> "#include "++h_file
 509                    '<':_      -> "#include "++h_file
 510                    _          -> "#include \""++h_file++"\""
 511
 512         cc_help <- newTempName "c"
 513         h <- openFile cc_help WriteMode
 514         hPutStr h cc_injects
 515         hPutStrLn h ("#include \"" ++ input_fn ++ "\"\n")
 516         hClose h
 517
 518         ccout <- newTempName "ccout"
 519
 520         mangle <- readIORef v_Do_asm_mangling
 521         (md_c_flags, md_regd_c_flags) <- machdepCCOpts
 522
 523         verb <- is_verbose
 524
 525         o2 <- readIORef v_minus_o2_for_C
 526         let opt_flag | o2        = "-O2"
 527                      | otherwise = "-O"
 528
 529         pkg_extra_cc_opts <- getPackageExtraCcOpts
 530
 531         split_objs <- readIORef v_Split_object_files
 532         let split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
 533                       | otherwise         = [ ]
 534
 535         excessPrecision <- readIORef v_Excess_precision
 536
 537         run_something "C Compiler"
 538          (unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
 539                    ++ md_c_flags
 540                    ++ (if cc_phase == HCc && mangle
 541                          then md_regd_c_flags
 542                          else [])
 543                    ++ [ verb, "-S", "-Wimplicit", opt_flag ]
 544                    ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 545                    ++ cc_opts
 546                    ++ split_opt
 547 #ifdef mingw32_TARGET_OS
 548                    ++ [" -mno-cygwin"]
 549 #endif
 550                    ++ (if excessPrecision then [] else [ "-ffloat-store" ])
 551                    ++ include_paths
 552                    ++ pkg_extra_cc_opts
 553 --                 ++ [">", ccout]
 554                    ))
 555         return True
 556
 557         -- ToDo: postprocess the output from gcc
 558
 559 -----------------------------------------------------------------------------
 560 -- Mangle phase
 561
 562 run_phase Mangle _basename _suff input_fn output_fn
 563   = do mangler <- readIORef v_Pgm_m
 564        mangler_opts <- getOpts opt_m
 565        machdep_opts <-
 566          if (prefixMatch "i386" cTARGETPLATFORM)
 567             then do n_regs <- readState stolen_x86_regs
 568                     return [ show n_regs ]
 569             else return []
 570        run_something "Assembly Mangler"
 571         (unwords (mangler :
 572                      mangler_opts
 573                   ++ [ input_fn, output_fn ]
 574                   ++ machdep_opts
 575                 ))
 576        return True
 577
 578 -----------------------------------------------------------------------------
 579 -- Splitting phase
 580
 581 run_phase SplitMangle _basename _suff input_fn _output_fn
 582   = do  splitter <- readIORef v_Pgm_s
 583
 584         -- this is the prefix used for the split .s files
 585         tmp_pfx <- readIORef v_TmpDir
 586         x <- myGetProcessID
 587         let split_s_prefix = tmp_pfx ++ "/ghc" ++ show x
 588         writeIORef v_Split_prefix split_s_prefix
 589         addFilesToClean [split_s_prefix ++ "__*"] -- d:-)
 590
 591         -- allocate a tmp file to put the no. of split .s files in (sigh)
 592         n_files <- newTempName "n_files"
 593
 594         run_something "Split Assembly File"
 595          (unwords [ splitter
 596                   , input_fn
 597                   , split_s_prefix
 598                   , n_files ]
 599          )
 600
 601         -- save the number of split files for future references
 602         s <- readFile n_files
 603         let n = read s :: Int
 604         writeIORef v_N_split_files n
 605         return True
 606
 607 -----------------------------------------------------------------------------
 608 -- As phase
 609
 610 run_phase As _basename _suff input_fn output_fn
 611   = do  as <- readIORef v_Pgm_a
 612         as_opts <- getOpts opt_a
 613
 614         cmdline_include_paths <- readIORef v_Include_paths
 615         let cmdline_include_flags = map (\p -> "-I"++p) cmdline_include_paths
 616         run_something "Assembler"
 617            (unwords (as : as_opts
 618                        ++ cmdline_include_flags
 619                        ++ [ "-c", input_fn, "-o",  output_fn ]
 620                     ))
 621         return True
 622
 623 run_phase SplitAs basename _suff _input_fn _output_fn
 624   = do  as <- readIORef v_Pgm_a
 625         as_opts <- getOpts opt_a
 626
 627         split_s_prefix <- readIORef v_Split_prefix
 628         n <- readIORef v_N_split_files
 629
 630         odir <- readIORef v_Output_dir
 631         let real_odir = case odir of
 632                                 Nothing -> basename
 633                                 Just d  -> d
 634
 635         let assemble_file n = do
 636                     let input_s  = split_s_prefix ++ "__" ++ show n ++ ".s"
 637                     let output_o = newdir real_odir
 638                                         (basename ++ "__" ++ show n ++ ".o")
 639                     real_o <- osuf_ify output_o
 640                     run_something "Assembler"
 641                             (unwords (as : as_opts
 642                                       ++ [ "-c", "-o", real_o, input_s ]
 643                             ))
 644
 645         mapM_ assemble_file [1..n]
 646         return True
 647
 648 -----------------------------------------------------------------------------
 649 -- Linking
 650
 651 doLink :: [String] -> IO ()
 652 doLink o_files = do
 653     ln <- readIORef v_Pgm_l
 654     verb <- is_verbose
 655     static <- readIORef v_Static
 656     let imp = if static then "" else "_imp"
 657     no_hs_main <- readIORef v_NoHsMain
 658
 659     o_file <- readIORef v_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 v_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 ++ imp) pkg_libs
 670
 671     libs <- readIORef v_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 v_Ld_inputs
 679
 680         -- opts from -optl-<blah>
 681     extra_ld_opts <- getStaticOpts v_Opt_l
 682
 683     rts_pkg <- getPackageDetails ["rts"]
 684     std_pkg <- getPackageDetails ["std"]
 685 #ifdef mingw32_TARGET_OS
 686     let extra_os = if static || no_hs_main
 687                    then []
 688                    else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
 689                           head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
 690 #endif
 691     (md_c_flags, _) <- machdepCCOpts
 692     run_something "Linker"
 693        (unwords
 694          ([ ln, verb, "-o", output_fn ]
 695          ++ md_c_flags
 696          ++ o_files
 697 #ifdef mingw32_TARGET_OS
 698          ++ extra_os
 699 #endif
 700          ++ extra_ld_inputs
 701          ++ lib_path_opts
 702          ++ lib_opts
 703          ++ pkg_lib_path_opts
 704          ++ pkg_lib_opts
 705          ++ pkg_extra_ld_opts
 706          ++ extra_ld_opts
 707 #ifdef mingw32_TARGET_OS
 708          ++ if static then [ "-u _PrelMain_mainIO_closure" , "-u ___init_PrelMain"] else []
 709 #else
 710          ++ [ "-u PrelMain_mainIO_closure" , "-u __init_PrelMain"]
 711 #endif
 712         )
 713        )
 714
 715 -----------------------------------------------------------------------------
 716 -- Just preprocess a file, put the result in a temp. file (used by the
 717 -- compilation manager during the summary phase).
 718
 719 preprocess :: FilePath -> IO FilePath
 720 preprocess filename =
 721   ASSERT(haskellish_file filename)
 722   do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False filename
 723      runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
 724
 725
 726 -----------------------------------------------------------------------------
 727 -- Compile a single module, under the control of the compilation manager.
 728 --
 729 -- This is the interface between the compilation manager and the
 730 -- compiler proper (hsc), where we deal with tedious details like
 731 -- reading the OPTIONS pragma from the source file, and passing the
 732 -- output of hsc through the C compiler.
 733
 734 -- The driver sits between 'compile' and 'hscMain', translating calls
 735 -- to the former into calls to the latter, and results from the latter
 736 -- into results from the former.  It does things like preprocessing
 737 -- the .hs file if necessary, and compiling up the .stub_c files to
 738 -- generate Linkables.
 739
 740 compile :: ModSummary              -- summary, including source
 741         -> Maybe ModIface          -- old interface, if available
 742         -> HomeSymbolTable         -- for home module ModDetails
 743         -> HomeIfaceTable          -- for home module Ifaces
 744         -> PersistentCompilerState -- persistent compiler state
 745         -> IO CompResult
 746
 747 data CompResult
 748    = CompOK   ModDetails  -- new details (HST additions)
 749               (Maybe (ModIface, Linkable))
 750                        -- summary and code; Nothing => compilation not reqd
 751                        -- (old summary and code are still valid)
 752               PersistentCompilerState   -- updated PCS
 753
 754    | CompErrs PersistentCompilerState   -- updated PCS
 755
 756
 757 compile summary old_iface hst hit pcs = do
 758    verb <- readIORef v_Verbose
 759    when verb (hPutStrLn stderr
 760                  (showSDoc (text "compile: compiling"
 761                             <+> ppr (name_of_summary summary))))
 762
 763    init_dyn_flags <- readIORef v_InitDynFlags
 764    writeIORef v_DynFlags init_dyn_flags
 765
 766    let location = ms_location summary
 767    let input_fn = unJust (ml_hs_file location) "compile:hs"
 768
 769    when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
 770
 771    opts <- getOptionsFromSource input_fn
 772    processArgs dynamic_flags opts []
 773    dyn_flags <- readIORef v_DynFlags
 774
 775    hsc_lang <- readIORef v_Hsc_Lang
 776    output_fn <- case hsc_lang of
 777                     HscAsm         -> newTempName (phaseInputExt As)
 778                     HscC           -> newTempName (phaseInputExt HCc)
 779                     HscJava        -> newTempName "java" -- ToDo
 780                     HscInterpreted -> return (error "no output file")
 781
 782    -- run the compiler
 783    hsc_result <- hscMain dyn_flags{ hscOutName = output_fn }
 784                          (panic "compile:source_unchanged")
 785                          location old_iface hst hit pcs
 786
 787    case hsc_result of {
 788       HscFail pcs -> return (CompErrs pcs);
 789
 790       HscOK details maybe_iface
 791         maybe_stub_h maybe_stub_c maybe_interpreted_code pcs -> do
 792
 793            -- if no compilation happened, bail out early
 794            case maybe_iface of {
 795                 Nothing -> return (CompOK details Nothing pcs);
 796                 Just iface -> do
 797
 798            let (basename, _) = splitFilename input_fn
 799            maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
 800            let stub_unlinked = case maybe_stub_o of
 801                                   Nothing -> []
 802                                   Just stub_o -> [ DotO stub_o ]
 803
 804            hs_unlinked <-
 805              case hsc_lang of
 806
 807                 -- in interpreted mode, just return the compiled code
 808                 -- as our "unlinked" object.
 809                 HscInterpreted ->
 810                     case maybe_interpreted_code of
 811                         Just (code,itbl_env) -> return [Trees code itbl_env]
 812                         Nothing -> panic "compile: no interpreted code"
 813
 814                 -- we're in batch mode: finish the compilation pipeline.
 815                 _other -> do pipe <- genPipeline (StopBefore Ln) "" True output_fn
 816                              o_file <- runPipeline pipe output_fn False False
 817                              return [ DotO o_file ]
 818
 819            let linkable = LM (moduleName (ms_mod summary))
 820                                 (hs_unlinked ++ stub_unlinked)
 821
 822            return (CompOK details (Just (iface, linkable)) pcs)
 823           }
 824    }
 825
 826 -----------------------------------------------------------------------------
 827 -- stub .h and .c files (for foreign export support)
 828
 829 dealWithStubs basename maybe_stub_h maybe_stub_c
 830
 831  = do   let stub_h = basename ++ "_stub.h"
 832         let stub_c = basename ++ "_stub.c"
 833
 834   -- copy the .stub_h file into the current dir if necessary
 835         case maybe_stub_h of
 836            Nothing -> return ()
 837            Just tmp_stub_h -> do
 838                 run_something "Copy stub .h file"
 839                                 ("cp " ++ tmp_stub_h ++ ' ':stub_h)
 840
 841                         -- #include <..._stub.h> in .hc file
 842                 addCmdlineHCInclude tmp_stub_h  -- hack
 843
 844   -- copy the .stub_c file into the current dir, and compile it, if necessary
 845         case maybe_stub_c of
 846            Nothing -> return Nothing
 847            Just tmp_stub_c -> do  -- copy the _stub.c file into the current dir
 848                 run_something "Copy stub .c file"
 849                     (unwords [
 850                         "rm -f", stub_c, "&&",
 851                         "echo \'#include \""++stub_h++"\"\' >"++stub_c, " &&",
 852                         "cat", tmp_stub_c, ">> ", stub_c
 853                         ])
 854
 855                         -- compile the _stub.c file w/ gcc
 856                 pipeline <- genPipeline (StopBefore Ln) "" True stub_c
 857                 stub_o <- runPipeline pipeline stub_c False{-no linking-}
 858                                 False{-no -o option-}
 859
 860                 return (Just stub_o)