ghc/compiler/main/DriverPipeline.hs

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