ghc/compiler/main/DriverPipeline.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverPipeline.hs,v 1.13 2000/10/30 18:13:15 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,
  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    -> String            -- original filename
 123    -> IO [              -- list of phases to run for this file
 124              (Phase,
 125               IntermediateFileType,  -- keep the output from this phase?
 126               String)                -- output file suffix
 127          ]
 128
 129 genPipeline todo stop_flag filename
 130  = do
 131    split      <- readIORef v_Split_object_files
 132    mangle     <- readIORef v_Do_asm_mangling
 133    lang       <- readIORef v_Hsc_Lang
 134    keep_hc    <- readIORef v_Keep_hc_files
 135    keep_raw_s <- readIORef v_Keep_raw_s_files
 136    keep_s     <- readIORef v_Keep_s_files
 137
 138    let
 139    ----------- -----  ----   ---   --   --  -  -  -
 140     (_basename, suffix) = splitFilename filename
 141
 142     start_phase = startPhase suffix
 143
 144     haskellish = haskellish_suffix suffix
 145     cish = cish_suffix suffix
 146
 147    -- for a .hc file, or if the -C flag is given, we need to force lang to HscC
 148     real_lang | suffix == "hc"  = HscC
 149               | otherwise       = lang
 150
 151    let
 152    ----------- -----  ----   ---   --   --  -  -  -
 153     pipeline
 154       | todo == DoMkDependHS = [ Unlit, Cpp, MkDependHS ]
 155
 156       | haskellish =
 157        case real_lang of
 158         HscC    | split && mangle -> [ Unlit, Cpp, Hsc, HCc, Mangle,
 159                                         SplitMangle, SplitAs ]
 160                 | mangle          -> [ Unlit, Cpp, Hsc, HCc, Mangle, As ]
 161                 | split           -> not_valid
 162                 | otherwise       -> [ Unlit, Cpp, Hsc, HCc, As ]
 163
 164         HscAsm  | split           -> [ Unlit, Cpp, Hsc, SplitMangle, SplitAs ]
 165                 | otherwise       -> [ Unlit, Cpp, Hsc, As ]
 166
 167         HscJava | split           -> not_valid
 168                 | otherwise       -> error "not implemented: compiling via Java"
 169
 170       | cish      = [ Cc, As ]
 171
 172       | otherwise = [ ]  -- just pass this file through to the linker
 173
 174         -- ToDo: this is somewhat cryptic
 175     not_valid = throwDyn (OtherError ("invalid option combination"))
 176    ----------- -----  ----   ---   --   --  -  -  -
 177
 178         -- this shouldn't happen.
 179    if start_phase /= Ln && start_phase `notElem` pipeline
 180         then throwDyn (OtherError ("can't find starting phase for "
 181                                     ++ filename))
 182         else do
 183
 184         -- if we can't find the phase we're supposed to stop before,
 185         -- something has gone wrong.
 186    case todo of
 187         StopBefore phase ->
 188            when (phase /= Ln
 189                  && phase `notElem` pipeline
 190                  && not (phase == As && SplitAs `elem` pipeline)) $
 191               throwDyn (OtherError
 192                 ("flag " ++ stop_flag
 193                  ++ " is incompatible with source file `" ++ filename ++ "'"))
 194         _ -> return ()
 195
 196    let
 197    ----------- -----  ----   ---   --   --  -  -  -
 198       annotatePipeline
 199          :: [Phase]             -- raw pipeline
 200          -> Phase               -- phase to stop before
 201          -> [(Phase, IntermediateFileType, String{-file extension-})]
 202       annotatePipeline []     _    = []
 203       annotatePipeline (Ln:_) _    = []
 204       annotatePipeline (phase:next_phase:ps) stop =
 205           (phase, keep_this_output, phaseInputExt next_phase)
 206              : annotatePipeline (next_phase:ps) stop
 207           where
 208                 keep_this_output
 209                      | next_phase == stop = Persistent
 210                      | otherwise =
 211                         case next_phase of
 212                              Ln -> Persistent
 213                              Mangle | keep_raw_s -> Persistent
 214                              As     | keep_s     -> Persistent
 215                              HCc    | keep_hc    -> Persistent
 216                              _other              -> Temporary
 217
 218         -- add information about output files to the pipeline
 219         -- the suffix on an output file is determined by the next phase
 220         -- in the pipeline, so we add linking to the end of the pipeline
 221         -- to force the output from the final phase to be a .o file.
 222       stop_phase = case todo of StopBefore phase -> phase
 223                                 DoMkDependHS     -> Ln
 224                                 DoLink           -> Ln
 225       annotated_pipeline = annotatePipeline (pipeline ++ [ Ln ]) stop_phase
 226
 227       phase_ne p (p1,_,_) = (p1 /= p)
 228    ----------- -----  ----   ---   --   --  -  -  -
 229
 230    return $
 231      dropWhile (phase_ne start_phase) .
 232         foldr (\p ps -> if phase_ne stop_phase p then p:ps else [])  []
 233                 $ annotated_pipeline
 234
 235
 236 runPipeline
 237   :: [ (Phase, IntermediateFileType, String) ] -- phases to run
 238   -> String                     -- input file
 239   -> Bool                       -- doing linking afterward?
 240   -> Bool                       -- take into account -o when generating output?
 241   -> IO String                  -- return final filename
 242
 243 runPipeline pipeline input_fn do_linking use_ofile
 244   = pipeLoop pipeline input_fn do_linking use_ofile basename suffix
 245   where (basename, suffix) = splitFilename input_fn
 246
 247 pipeLoop [] input_fn _ _ _ _ = return input_fn
 248 pipeLoop ((phase, keep, o_suffix):phases)
 249         input_fn do_linking use_ofile orig_basename orig_suffix
 250   = do
 251
 252      output_fn <- outputFileName (null phases) keep o_suffix
 253
 254      carry_on <- run_phase phase orig_basename orig_suffix input_fn output_fn
 255         -- sometimes we bail out early, eg. when the compiler's recompilation
 256         -- checker has determined that recompilation isn't necessary.
 257      if not carry_on
 258         then do let (_,keep,final_suffix) = last phases
 259                 ofile <- outputFileName True keep final_suffix
 260                 return ofile
 261         else do -- carry on ...
 262
 263         -- sadly, ghc -E is supposed to write the file to stdout.  We
 264         -- generate <file>.cpp, so we also have to cat the file here.
 265      when (null phases && phase == Cpp) $
 266         run_something "Dump pre-processed file to stdout"
 267                       ("cat " ++ output_fn)
 268
 269      pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
 270
 271   where
 272      outputFileName last_phase keep suffix
 273         = do o_file <- readIORef v_Output_file
 274              if last_phase && not do_linking && use_ofile && isJust o_file
 275                then case o_file of
 276                        Just s  -> return s
 277                        Nothing -> error "outputFileName"
 278                else if keep == Persistent
 279                            then do f <- odir_ify (orig_basename ++ '.':suffix)
 280                                    osuf_ify f
 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        _ <- processArgs dynamic_flags src_opts []
 300
 301        do_cpp <- readState cpp_flag
 302        if do_cpp
 303           then do
 304             cpp <- readIORef v_Pgm_P
 305             hscpp_opts <- getOpts opt_P
 306             hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
 307
 308             cmdline_include_paths <- readIORef v_Include_paths
 309             pkg_include_dirs <- getPackageIncludePath
 310             let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
 311                                                         ++ pkg_include_dirs)
 312
 313             verb <- is_verbose
 314             run_something "C pre-processor"
 315                 (unwords
 316                    (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
 317                      cpp, verb]
 318                     ++ include_paths
 319                     ++ hs_src_cpp_opts
 320                     ++ hscpp_opts
 321                     ++ [ "-x", "c", input_fn, ">>", output_fn ]
 322                    ))
 323           else do
 324             run_something "Ineffective C pre-processor"
 325                    ("echo '{-# LINE 1 \""  ++ input_fn ++ "\" -}' > "
 326                     ++ output_fn ++ " && cat " ++ input_fn
 327                     ++ " >> " ++ output_fn)
 328        return True
 329
 330 -----------------------------------------------------------------------------
 331 -- MkDependHS phase
 332
 333 run_phase MkDependHS basename suff input_fn _output_fn = do
 334    src <- readFile input_fn
 335    let imports = getImports src
 336
 337    deps <- mapM (findDependency basename) imports
 338
 339    osuf_opt <- readIORef v_Output_suf
 340    let osuf = case osuf_opt of
 341                         Nothing -> "o"
 342                         Just s  -> s
 343
 344    extra_suffixes <- readIORef v_Dep_suffixes
 345    let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
 346        ofiles = map (\suf -> basename ++ '.':suf) suffixes
 347
 348    objs <- mapM odir_ify ofiles
 349
 350    hdl <- readIORef v_Dep_tmp_hdl
 351
 352         -- std dependeny of the object(s) on the source file
 353    hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
 354
 355    let genDep (dep, False {- not an hi file -}) =
 356           hPutStrLn hdl (unwords objs ++ " : " ++ dep)
 357        genDep (dep, True  {- is an hi file -}) = do
 358           hisuf <- readIORef v_Hi_suf
 359           let dep_base = remove_suffix '.' dep
 360               deps = (dep_base ++ hisuf)
 361                      : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
 362                   -- length objs should be == length deps
 363           sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps)
 364
 365    mapM genDep [ d | Just d <- deps ]
 366
 367    return True
 368
 369 -- add the lines to dep_makefile:
 370            -- always:
 371                    -- this.o : this.hs
 372
 373            -- if the dependency is on something other than a .hi file:
 374                    -- this.o this.p_o ... : dep
 375            -- otherwise
 376                    -- if the import is {-# SOURCE #-}
 377                            -- this.o this.p_o ... : dep.hi-boot[-$vers]
 378
 379                    -- else
 380                            -- this.o ...   : dep.hi
 381                            -- this.p_o ... : dep.p_hi
 382                            -- ...
 383
 384            -- (where .o is $osuf, and the other suffixes come from
 385            -- the cmdline -s options).
 386
 387 -----------------------------------------------------------------------------
 388 -- Hsc phase
 389
 390 -- Compilation of a single module, in "legacy" mode (_not_ under
 391 -- the direction of the compilation manager).
 392 run_phase Hsc basename suff input_fn output_fn
 393   = do
 394
 395   -- we add the current directory (i.e. the directory in which
 396   -- the .hs files resides) to the import path, since this is
 397   -- what gcc does, and it's probably what you want.
 398         let current_dir = getdir basename
 399
 400         paths <- readIORef v_Include_paths
 401         writeIORef v_Include_paths (current_dir : paths)
 402
 403   -- figure out where to put the .hi file
 404         ohi    <- readIORef v_Output_hi
 405         hisuf  <- readIORef v_Hi_suf
 406         let hifile = case ohi of
 407                            Nothing -> current_dir ++ "/" ++ basename
 408                                         ++ "." ++ hisuf
 409                            Just fn -> fn
 410
 411   -- figure out if the source has changed, for recompilation avoidance.
 412   -- only do this if we're eventually going to generate a .o file.
 413   -- (ToDo: do when generating .hc files too?)
 414   --
 415   -- Setting source_unchanged to "-fsource-unchanged" means that M.o seems
 416   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 417   -- changed (which the compiler itself figures out).
 418   -- Setting source_unchanged to "" tells the compiler that M.o is out of
 419   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 420         do_recomp <- readIORef v_Recomp
 421         todo <- readIORef v_GhcMode
 422         o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
 423         source_unchanged <-
 424           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
 425              then return ""
 426              else do t1 <- getModificationTime (basename ++ '.':suff)
 427                      o_file_exists <- doesFileExist o_file
 428                      if not o_file_exists
 429                         then return ""  -- Need to recompile
 430                         else do t2 <- getModificationTime o_file
 431                                 if t2 > t1
 432                                   then return "-fsource-unchanged"
 433                                   else return ""
 434
 435    -- build a bogus ModuleLocation to pass to hscMain.
 436         let location = ModuleLocation {
 437                           ml_hs_file   = Nothing,
 438                           ml_hspp_file = Just input_fn,
 439                           ml_hi_file   = Just hifile,
 440                           ml_obj_file  = Just o_file
 441                        }
 442
 443   -- get the DynFlags
 444         dyn_flags <- readIORef v_DynFlags
 445
 446   -- run the compiler!
 447         pcs <- initPersistentCompilerState
 448         result <- hscMain dyn_flags{ hscOutName = output_fn }
 449                           (source_unchanged == "-fsource-unchanged")
 450                           location
 451                           Nothing        -- no iface
 452                           emptyModuleEnv -- HomeSymbolTable
 453                           emptyModuleEnv -- HomeIfaceTable
 454                           pcs
 455
 456         case result of {
 457
 458             HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
 459
 460             HscOK details maybe_iface maybe_stub_h maybe_stub_c
 461                         _maybe_interpreted_code pcs -> do
 462
 463     -- deal with stubs
 464         maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
 465         case maybe_stub_o of
 466                 Nothing -> return ()
 467                 Just stub_o -> add v_Ld_inputs stub_o
 468
 469         return True
 470     }
 471
 472 -----------------------------------------------------------------------------
 473 -- Cc phase
 474
 475 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 476 -- way too many hacks, and I can't say I've ever used it anyway.
 477
 478 run_phase cc_phase _basename _suff input_fn output_fn
 479    | cc_phase == Cc || cc_phase == HCc
 480    = do cc <- readIORef v_Pgm_c
 481         cc_opts <- (getOpts opt_c)
 482         cmdline_include_dirs <- readIORef v_Include_paths
 483
 484         let hcc = cc_phase == HCc
 485
 486                 -- add package include paths even if we're just compiling
 487                 -- .c files; this is the Value Add(TM) that using
 488                 -- ghc instead of gcc gives you :)
 489         pkg_include_dirs <- getPackageIncludePath
 490         let include_paths = map (\p -> "-I"++p) (cmdline_include_dirs
 491                                                         ++ pkg_include_dirs)
 492
 493         c_includes <- getPackageCIncludes
 494         cmdline_includes <- readState cmdline_hc_includes -- -#include options
 495
 496         let cc_injects | hcc = unlines (map mk_include
 497                                         (c_includes ++ reverse cmdline_includes))
 498                        | otherwise = ""
 499             mk_include h_file =
 500                 case h_file of
 501                    '"':_{-"-} -> "#include "++h_file
 502                    '<':_      -> "#include "++h_file
 503                    _          -> "#include \""++h_file++"\""
 504
 505         cc_help <- newTempName "c"
 506         h <- openFile cc_help WriteMode
 507         hPutStr h cc_injects
 508         hPutStrLn h ("#include \"" ++ input_fn ++ "\"\n")
 509         hClose h
 510
 511         ccout <- newTempName "ccout"
 512
 513         mangle <- readIORef v_Do_asm_mangling
 514         (md_c_flags, md_regd_c_flags) <- machdepCCOpts
 515
 516         verb <- is_verbose
 517
 518         o2 <- readIORef v_minus_o2_for_C
 519         let opt_flag | o2        = "-O2"
 520                      | otherwise = "-O"
 521
 522         pkg_extra_cc_opts <- getPackageExtraCcOpts
 523
 524         excessPrecision <- readIORef v_Excess_precision
 525
 526         run_something "C Compiler"
 527          (unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
 528                    ++ md_c_flags
 529                    ++ (if cc_phase == HCc && mangle
 530                          then md_regd_c_flags
 531                          else [])
 532                    ++ [ verb, "-S", "-Wimplicit", opt_flag ]
 533                    ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 534                    ++ cc_opts
 535 #ifdef mingw32_TARGET_OS
 536                    ++ [" -mno-cygwin"]
 537 #endif
 538                    ++ (if excessPrecision then [] else [ "-ffloat-store" ])
 539                    ++ include_paths
 540                    ++ pkg_extra_cc_opts
 541 --                 ++ [">", ccout]
 542                    ))
 543         return True
 544
 545         -- ToDo: postprocess the output from gcc
 546
 547 -----------------------------------------------------------------------------
 548 -- Mangle phase
 549
 550 run_phase Mangle _basename _suff input_fn output_fn
 551   = do mangler <- readIORef v_Pgm_m
 552        mangler_opts <- getOpts opt_m
 553        machdep_opts <-
 554          if (prefixMatch "i386" cTARGETPLATFORM)
 555             then do n_regs <- readState stolen_x86_regs
 556                     return [ show n_regs ]
 557             else return []
 558        run_something "Assembly Mangler"
 559         (unwords (mangler :
 560                      mangler_opts
 561                   ++ [ input_fn, output_fn ]
 562                   ++ machdep_opts
 563                 ))
 564        return True
 565
 566 -----------------------------------------------------------------------------
 567 -- Splitting phase
 568
 569 run_phase SplitMangle _basename _suff input_fn _output_fn
 570   = do  splitter <- readIORef v_Pgm_s
 571
 572         -- this is the prefix used for the split .s files
 573         tmp_pfx <- readIORef v_TmpDir
 574         x <- myGetProcessID
 575         let split_s_prefix = tmp_pfx ++ "/ghc" ++ show x
 576         writeIORef v_Split_prefix split_s_prefix
 577         addFilesToClean [split_s_prefix ++ "__*"] -- d:-)
 578
 579         -- allocate a tmp file to put the no. of split .s files in (sigh)
 580         n_files <- newTempName "n_files"
 581
 582         run_something "Split Assembly File"
 583          (unwords [ splitter
 584                   , input_fn
 585                   , split_s_prefix
 586                   , n_files ]
 587          )
 588
 589         -- save the number of split files for future references
 590         s <- readFile n_files
 591         let n = read s :: Int
 592         writeIORef v_N_split_files n
 593         return True
 594
 595 -----------------------------------------------------------------------------
 596 -- As phase
 597
 598 run_phase As _basename _suff input_fn output_fn
 599   = do  as <- readIORef v_Pgm_a
 600         as_opts <- getOpts opt_a
 601
 602         cmdline_include_paths <- readIORef v_Include_paths
 603         let cmdline_include_flags = map (\p -> "-I"++p) cmdline_include_paths
 604         run_something "Assembler"
 605            (unwords (as : as_opts
 606                        ++ cmdline_include_flags
 607                        ++ [ "-c", input_fn, "-o",  output_fn ]
 608                     ))
 609         return True
 610
 611 run_phase SplitAs basename _suff _input_fn _output_fn
 612   = do  as <- readIORef v_Pgm_a
 613         as_opts <- getOpts opt_a
 614
 615         split_s_prefix <- readIORef v_Split_prefix
 616         n <- readIORef v_N_split_files
 617
 618         odir <- readIORef v_Output_dir
 619         let real_odir = case odir of
 620                                 Nothing -> basename
 621                                 Just d  -> d
 622
 623         let assemble_file n = do
 624                     let input_s  = split_s_prefix ++ "__" ++ show n ++ ".s"
 625                     let output_o = newdir real_odir
 626                                         (basename ++ "__" ++ show n ++ ".o")
 627                     real_o <- osuf_ify output_o
 628                     run_something "Assembler"
 629                             (unwords (as : as_opts
 630                                       ++ [ "-c", "-o", real_o, input_s ]
 631                             ))
 632
 633         mapM_ assemble_file [1..n]
 634         return True
 635
 636 -----------------------------------------------------------------------------
 637 -- Linking
 638
 639 doLink :: [String] -> IO ()
 640 doLink o_files = do
 641     ln <- readIORef v_Pgm_l
 642     verb <- is_verbose
 643     o_file <- readIORef v_Output_file
 644     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 645
 646     pkg_lib_paths <- getPackageLibraryPath
 647     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 648
 649     lib_paths <- readIORef v_Library_paths
 650     let lib_path_opts = map ("-L"++) lib_paths
 651
 652     pkg_libs <- getPackageLibraries
 653     let pkg_lib_opts = map (\lib -> "-l"++lib) pkg_libs
 654
 655     libs <- readIORef v_Cmdline_libraries
 656     let lib_opts = map ("-l"++) (reverse libs)
 657          -- reverse because they're added in reverse order from the cmd line
 658
 659     pkg_extra_ld_opts <- getPackageExtraLdOpts
 660
 661         -- probably _stub.o files
 662     extra_ld_inputs <- readIORef v_Ld_inputs
 663
 664         -- opts from -optl-<blah>
 665     extra_ld_opts <- getStaticOpts v_Opt_l
 666
 667     run_something "Linker"
 668        (unwords
 669          ([ ln, verb, "-o", output_fn ]
 670          ++ o_files
 671          ++ extra_ld_inputs
 672          ++ lib_path_opts
 673          ++ lib_opts
 674          ++ pkg_lib_path_opts
 675          ++ pkg_lib_opts
 676          ++ pkg_extra_ld_opts
 677          ++ extra_ld_opts
 678         )
 679        )
 680
 681 -----------------------------------------------------------------------------
 682 -- Just preprocess a file, put the result in a temp. file (used by the
 683 -- compilation manager during the summary phase).
 684
 685 preprocess :: FilePath -> IO FilePath
 686 preprocess filename =
 687   ASSERT(haskellish_file filename)
 688   do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") filename
 689      runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
 690
 691
 692 -----------------------------------------------------------------------------
 693 -- Compile a single module, under the control of the compilation manager.
 694 --
 695 -- This is the interface between the compilation manager and the
 696 -- compiler proper (hsc), where we deal with tedious details like
 697 -- reading the OPTIONS pragma from the source file, and passing the
 698 -- output of hsc through the C compiler.
 699
 700 -- The driver sits between 'compile' and 'hscMain', translating calls
 701 -- to the former into calls to the latter, and results from the latter
 702 -- into results from the former.  It does things like preprocessing
 703 -- the .hs file if necessary, and compiling up the .stub_c files to
 704 -- generate Linkables.
 705
 706 compile :: ModSummary              -- summary, including source
 707         -> Maybe ModIface          -- old interface, if available
 708         -> HomeSymbolTable         -- for home module ModDetails
 709         -> HomeIfaceTable          -- for home module Ifaces
 710         -> PersistentCompilerState -- persistent compiler state
 711         -> IO CompResult
 712
 713 data CompResult
 714    = CompOK   ModDetails  -- new details (HST additions)
 715               (Maybe (ModIface, Linkable))
 716                        -- summary and code; Nothing => compilation not reqd
 717                        -- (old summary and code are still valid)
 718               PersistentCompilerState   -- updated PCS
 719
 720    | CompErrs PersistentCompilerState   -- updated PCS
 721
 722
 723 compile summary old_iface hst hit pcs = do
 724    verb <- readIORef v_Verbose
 725    when verb (hPutStrLn stderr
 726                  (showSDoc (text "compile: compiling"
 727                             <+> ppr (name_of_summary summary))))
 728
 729    init_dyn_flags <- readIORef v_InitDynFlags
 730    writeIORef v_DynFlags init_dyn_flags
 731
 732    let location = ms_location summary
 733    let input_fn = unJust (ml_hs_file location) "compile:hs"
 734
 735    when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
 736
 737    opts <- getOptionsFromSource input_fn
 738    processArgs dynamic_flags opts []
 739    dyn_flags <- readIORef v_DynFlags
 740
 741    hsc_lang <- readIORef v_Hsc_Lang
 742    output_fn <- case hsc_lang of
 743                     HscAsm         -> newTempName (phaseInputExt As)
 744                     HscC           -> newTempName (phaseInputExt HCc)
 745                     HscJava        -> newTempName "java" -- ToDo
 746                     HscInterpreted -> return (error "no output file")
 747
 748    -- run the compiler
 749    hsc_result <- hscMain dyn_flags{ hscOutName = output_fn }
 750                          (panic "compile:source_unchanged")
 751                          location old_iface hst hit pcs
 752
 753    case hsc_result of {
 754       HscFail pcs -> return (CompErrs pcs);
 755
 756       HscOK details maybe_iface
 757         maybe_stub_h maybe_stub_c maybe_interpreted_code pcs -> do
 758
 759            -- if no compilation happened, bail out early
 760            case maybe_iface of {
 761                 Nothing -> return (CompOK details Nothing pcs);
 762                 Just iface -> do
 763
 764            let (basename, _) = splitFilename input_fn
 765            maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
 766            let stub_unlinked = case maybe_stub_o of
 767                                   Nothing -> []
 768                                   Just stub_o -> [ DotO stub_o ]
 769
 770            hs_unlinked <-
 771              case hsc_lang of
 772
 773                 -- in interpreted mode, just return the compiled code
 774                 -- as our "unlinked" object.
 775                 HscInterpreted ->
 776                     case maybe_interpreted_code of
 777                         Just (code,itbl_env) -> return [Trees code itbl_env]
 778                         Nothing -> panic "compile: no interpreted code"
 779
 780                 -- we're in batch mode: finish the compilation pipeline.
 781                 _other -> do pipe <- genPipeline (StopBefore Ln) "" output_fn
 782                              o_file <- runPipeline pipe output_fn False False
 783                              return [ DotO o_file ]
 784
 785            let linkable = LM (moduleName (ms_mod summary))
 786                                 (hs_unlinked ++ stub_unlinked)
 787
 788            return (CompOK details (Just (iface, linkable)) pcs)
 789           }
 790    }
 791
 792 -----------------------------------------------------------------------------
 793 -- stub .h and .c files (for foreign export support)
 794
 795 dealWithStubs basename maybe_stub_h maybe_stub_c
 796
 797  = do   let stub_h = basename ++ "_stub.h"
 798         let stub_c = basename ++ "_stub.c"
 799
 800   -- copy the .stub_h file into the current dir if necessary
 801         case maybe_stub_h of
 802            Nothing -> return ()
 803            Just tmp_stub_h -> do
 804                 run_something "Copy stub .h file"
 805                                 ("cp " ++ tmp_stub_h ++ ' ':stub_h)
 806
 807                         -- #include <..._stub.h> in .hc file
 808                 addCmdlineHCInclude tmp_stub_h  -- hack
 809
 810   -- copy the .stub_c file into the current dir, and compile it, if necessary
 811         case maybe_stub_c of
 812            Nothing -> return Nothing
 813            Just tmp_stub_c -> do  -- copy the _stub.c file into the current dir
 814                 run_something "Copy stub .c file"
 815                     (unwords [
 816                         "rm -f", stub_c, "&&",
 817                         "echo \'#include \""++stub_h++"\"\' >"++stub_c, " &&",
 818                         "cat", tmp_stub_c, ">> ", stub_c
 819                         ])
 820
 821                         -- compile the _stub.c file w/ gcc
 822                 pipeline <- genPipeline (StopBefore Ln) "" stub_c
 823                 stub_o <- runPipeline pipeline stub_c False{-no linking-}
 824                                 False{-no -o option-}
 825
 826                 return (Just stub_o)