ghc/compiler/main/DriverPipeline.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverPipeline.hs,v 1.8 2000/10/26 16:21:02 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 Finder
  34 import TmpFiles
  35 import HscTypes
  36 import Outputable
  37 import Module
  38 import CmdLineOpts
  39 import Config
  40 import Util
  41 import MkIface          ( pprIface )
  42
  43 import Posix
  44 import Directory
  45 import System
  46 import IOExts
  47 -- import Posix         commented out temp by SLPJ to get going on windows
  48 import Exception
  49
  50 import IO
  51 import Monad
  52 import Maybe
  53
  54 -----------------------------------------------------------------------------
  55 -- GHC modes of operation
  56
  57 data GhcMode
  58   = DoMkDependHS                        -- ghc -M
  59   | DoMkDLL                             -- ghc -mk-dll
  60   | StopBefore Phase                    -- ghc -E | -C | -S | -c
  61   | DoMake                              -- ghc --make
  62   | DoInteractive                       -- ghc --interactive
  63   | DoLink                              -- [ the default ]
  64   deriving (Eq)
  65
  66 GLOBAL_VAR(v_GhcMode, error "todo", GhcMode)
  67
  68 modeFlag :: String -> Maybe GhcMode
  69 modeFlag "-M"            = Just $ DoMkDependHS
  70 modeFlag "-E"            = Just $ StopBefore Hsc
  71 modeFlag "-C"            = Just $ StopBefore HCc
  72 modeFlag "-S"            = Just $ StopBefore As
  73 modeFlag "-c"            = Just $ StopBefore Ln
  74 modeFlag "--make"        = Just $ DoMake
  75 modeFlag "--interactive" = Just $ DoInteractive
  76 modeFlag _               = Nothing
  77
  78 getGhcMode :: [String]
  79          -> IO ( [String]   -- rest of command line
  80                , GhcMode
  81                , String     -- "GhcMode" flag
  82                )
  83 getGhcMode flags
  84   = case my_partition modeFlag flags of
  85         ([]   , rest) -> return (rest, DoLink,  "") -- default is to do linking
  86         ([(flag,one)], rest) -> return (rest, one, flag)
  87         (_    , _   ) ->
  88           throwDyn (OtherError
  89                 "only one of the flags -M, -E, -C, -S, -c, --make, --interactive is allowed")
  90
  91 -----------------------------------------------------------------------------
  92 -- genPipeline
  93 --
  94 -- Herein is all the magic about which phases to run in which order, whether
  95 -- the intermediate files should be in /tmp or in the current directory,
  96 -- what the suffix of the intermediate files should be, etc.
  97
  98 -- The following compilation pipeline algorithm is fairly hacky.  A
  99 -- better way to do this would be to express the whole comilation as a
 100 -- data flow DAG, where the nodes are the intermediate files and the
 101 -- edges are the compilation phases.  This framework would also work
 102 -- nicely if a haskell dependency generator was included in the
 103 -- driver.
 104
 105 -- It would also deal much more cleanly with compilation phases that
 106 -- generate multiple intermediates, (eg. hsc generates .hc, .hi, and
 107 -- possibly stub files), where some of the output files need to be
 108 -- processed further (eg. the stub files need to be compiled by the C
 109 -- compiler).
 110
 111 -- A cool thing to do would then be to execute the data flow graph
 112 -- concurrently, automatically taking advantage of extra processors on
 113 -- the host machine.  For example, when compiling two Haskell files
 114 -- where one depends on the other, the data flow graph would determine
 115 -- that the C compiler from the first comilation can be overlapped
 116 -- with the hsc comilation for the second file.
 117
 118 data IntermediateFileType
 119   = Temporary
 120   | Persistent
 121   deriving (Eq)
 122
 123 genPipeline
 124    :: GhcMode           -- when to stop
 125    -> String            -- "stop after" flag (for error messages)
 126    -> String            -- original filename
 127    -> IO [              -- list of phases to run for this file
 128              (Phase,
 129               IntermediateFileType,  -- keep the output from this phase?
 130               String)                -- output file suffix
 131          ]
 132
 133 genPipeline todo stop_flag filename
 134  = do
 135    split      <- readIORef v_Split_object_files
 136    mangle     <- readIORef v_Do_asm_mangling
 137    lang       <- readIORef v_Hsc_Lang
 138    keep_hc    <- readIORef v_Keep_hc_files
 139    keep_raw_s <- readIORef v_Keep_raw_s_files
 140    keep_s     <- readIORef v_Keep_s_files
 141
 142    let
 143    ----------- -----  ----   ---   --   --  -  -  -
 144     (_basename, suffix) = splitFilename filename
 145
 146     start_phase = startPhase suffix
 147
 148     haskellish = haskellish_suffix suffix
 149     cish = cish_suffix suffix
 150
 151    -- for a .hc file, or if the -C flag is given, we need to force lang to HscC
 152     real_lang | suffix == "hc"  = HscC
 153               | otherwise       = lang
 154
 155    let
 156    ----------- -----  ----   ---   --   --  -  -  -
 157     pipeline
 158       | todo == DoMkDependHS = [ Unlit, Cpp, MkDependHS ]
 159
 160       | haskellish =
 161        case real_lang of
 162         HscC    | split && mangle -> [ Unlit, Cpp, Hsc, HCc, Mangle,
 163                                         SplitMangle, SplitAs ]
 164                 | mangle          -> [ Unlit, Cpp, Hsc, HCc, Mangle, As ]
 165                 | split           -> not_valid
 166                 | otherwise       -> [ Unlit, Cpp, Hsc, HCc, As ]
 167
 168         HscAsm  | split           -> [ Unlit, Cpp, Hsc, SplitMangle, SplitAs ]
 169                 | otherwise       -> [ Unlit, Cpp, Hsc, As ]
 170
 171         HscJava | split           -> not_valid
 172                 | otherwise       -> error "not implemented: compiling via Java"
 173
 174       | cish      = [ Cc, As ]
 175
 176       | otherwise = [ ]  -- just pass this file through to the linker
 177
 178         -- ToDo: this is somewhat cryptic
 179     not_valid = throwDyn (OtherError ("invalid option combination"))
 180    ----------- -----  ----   ---   --   --  -  -  -
 181
 182         -- this shouldn't happen.
 183    if start_phase /= Ln && start_phase `notElem` pipeline
 184         then throwDyn (OtherError ("can't find starting phase for "
 185                                     ++ filename))
 186         else do
 187
 188         -- if we can't find the phase we're supposed to stop before,
 189         -- something has gone wrong.
 190    case todo of
 191         StopBefore phase ->
 192            when (phase /= Ln
 193                  && phase `notElem` pipeline
 194                  && not (phase == As && SplitAs `elem` pipeline)) $
 195               throwDyn (OtherError
 196                 ("flag " ++ stop_flag
 197                  ++ " is incompatible with source file `" ++ filename ++ "'"))
 198         _ -> return ()
 199
 200    let
 201    ----------- -----  ----   ---   --   --  -  -  -
 202       annotatePipeline
 203          :: [Phase]             -- raw pipeline
 204          -> Phase               -- phase to stop before
 205          -> [(Phase, IntermediateFileType, String{-file extension-})]
 206       annotatePipeline []     _    = []
 207       annotatePipeline (Ln:_) _    = []
 208       annotatePipeline (phase:next_phase:ps) stop =
 209           (phase, keep_this_output, phaseInputExt next_phase)
 210              : annotatePipeline (next_phase:ps) stop
 211           where
 212                 keep_this_output
 213                      | next_phase == stop = Persistent
 214                      | otherwise =
 215                         case next_phase of
 216                              Ln -> Persistent
 217                              Mangle | keep_raw_s -> Persistent
 218                              As     | keep_s     -> Persistent
 219                              HCc    | keep_hc    -> Persistent
 220                              _other              -> Temporary
 221
 222         -- add information about output files to the pipeline
 223         -- the suffix on an output file is determined by the next phase
 224         -- in the pipeline, so we add linking to the end of the pipeline
 225         -- to force the output from the final phase to be a .o file.
 226       stop_phase = case todo of StopBefore phase -> phase
 227                                 DoMkDependHS     -> Ln
 228                                 DoLink           -> Ln
 229       annotated_pipeline = annotatePipeline (pipeline ++ [ Ln ]) stop_phase
 230
 231       phase_ne p (p1,_,_) = (p1 /= p)
 232    ----------- -----  ----   ---   --   --  -  -  -
 233
 234    return $
 235      dropWhile (phase_ne start_phase) .
 236         foldr (\p ps -> if phase_ne stop_phase p then p:ps else [])  []
 237                 $ annotated_pipeline
 238
 239
 240 runPipeline
 241   :: [ (Phase, IntermediateFileType, String) ] -- phases to run
 242   -> String                     -- input file
 243   -> Bool                       -- doing linking afterward?
 244   -> Bool                       -- take into account -o when generating output?
 245   -> IO String                  -- return final filename
 246
 247 runPipeline pipeline input_fn do_linking use_ofile
 248   = pipeLoop pipeline input_fn do_linking use_ofile basename suffix
 249   where (basename, suffix) = splitFilename input_fn
 250
 251 pipeLoop [] input_fn _ _ _ _ = return input_fn
 252 pipeLoop ((phase, keep, o_suffix):phases)
 253         input_fn do_linking use_ofile orig_basename orig_suffix
 254   = do
 255
 256      output_fn <- outputFileName (null phases) keep o_suffix
 257
 258      carry_on <- run_phase phase orig_basename orig_suffix input_fn output_fn
 259         -- sometimes we bail out early, eg. when the compiler's recompilation
 260         -- checker has determined that recompilation isn't necessary.
 261      if not carry_on
 262         then do let (_,keep,final_suffix) = last phases
 263                 ofile <- outputFileName True keep final_suffix
 264                 return ofile
 265         else do -- carry on ...
 266
 267         -- sadly, ghc -E is supposed to write the file to stdout.  We
 268         -- generate <file>.cpp, so we also have to cat the file here.
 269      when (null phases && phase == Cpp) $
 270         run_something "Dump pre-processed file to stdout"
 271                       ("cat " ++ output_fn)
 272
 273      pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
 274
 275   where
 276      outputFileName last_phase keep suffix
 277         = do o_file <- readIORef v_Output_file
 278              if last_phase && not do_linking && use_ofile && isJust o_file
 279                then case o_file of
 280                        Just s  -> return s
 281                        Nothing -> error "outputFileName"
 282                else if keep == Persistent
 283                            then do f <- odir_ify (orig_basename ++ '.':suffix)
 284                                    osuf_ify f
 285                            else newTempName suffix
 286
 287 -------------------------------------------------------------------------------
 288 -- Unlit phase
 289
 290 run_phase Unlit _basename _suff input_fn output_fn
 291   = do unlit <- readIORef v_Pgm_L
 292        unlit_flags <- getOpts opt_L
 293        run_something "Literate pre-processor"
 294           ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
 295            ++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
 296        return True
 297
 298 -------------------------------------------------------------------------------
 299 -- Cpp phase
 300
 301 run_phase Cpp _basename _suff input_fn output_fn
 302   = do src_opts <- getOptionsFromSource input_fn
 303        _ <- processArgs dynamic_flags src_opts []
 304
 305        do_cpp <- readState cpp_flag
 306        if do_cpp
 307           then do
 308             cpp <- readIORef v_Pgm_P
 309             hscpp_opts <- getOpts opt_P
 310             hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
 311
 312             cmdline_include_paths <- readIORef v_Include_paths
 313             pkg_include_dirs <- getPackageIncludePath
 314             let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
 315                                                         ++ pkg_include_dirs)
 316
 317             verb <- is_verbose
 318             run_something "C pre-processor"
 319                 (unwords
 320                    (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
 321                      cpp, verb]
 322                     ++ include_paths
 323                     ++ hs_src_cpp_opts
 324                     ++ hscpp_opts
 325                     ++ [ "-x", "c", input_fn, ">>", output_fn ]
 326                    ))
 327           else do
 328             run_something "Ineffective C pre-processor"
 329                    ("echo '{-# LINE 1 \""  ++ input_fn ++ "\" -}' > "
 330                     ++ output_fn ++ " && cat " ++ input_fn
 331                     ++ " >> " ++ output_fn)
 332        return True
 333
 334 -----------------------------------------------------------------------------
 335 -- MkDependHS phase
 336
 337 run_phase MkDependHS basename suff input_fn _output_fn = do
 338    src <- readFile input_fn
 339    let imports = getImports src
 340
 341    deps <- mapM (findDependency basename) imports
 342
 343    osuf_opt <- readIORef v_Output_suf
 344    let osuf = case osuf_opt of
 345                         Nothing -> "o"
 346                         Just s  -> s
 347
 348    extra_suffixes <- readIORef v_Dep_suffixes
 349    let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
 350        ofiles = map (\suf -> basename ++ '.':suf) suffixes
 351
 352    objs <- mapM odir_ify ofiles
 353
 354    hdl <- readIORef v_Dep_tmp_hdl
 355
 356         -- std dependeny of the object(s) on the source file
 357    hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
 358
 359    let genDep (dep, False {- not an hi file -}) =
 360           hPutStrLn hdl (unwords objs ++ " : " ++ dep)
 361        genDep (dep, True  {- is an hi file -}) = do
 362           hisuf <- readIORef v_Hi_suf
 363           let dep_base = remove_suffix '.' dep
 364               deps = (dep_base ++ hisuf)
 365                      : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
 366                   -- length objs should be == length deps
 367           sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps)
 368
 369    mapM genDep [ d | Just d <- deps ]
 370
 371    return True
 372
 373 -- add the lines to dep_makefile:
 374            -- always:
 375                    -- this.o : this.hs
 376
 377            -- if the dependency is on something other than a .hi file:
 378                    -- this.o this.p_o ... : dep
 379            -- otherwise
 380                    -- if the import is {-# SOURCE #-}
 381                            -- this.o this.p_o ... : dep.hi-boot[-$vers]
 382
 383                    -- else
 384                            -- this.o ...   : dep.hi
 385                            -- this.p_o ... : dep.p_hi
 386                            -- ...
 387
 388            -- (where .o is $osuf, and the other suffixes come from
 389            -- the cmdline -s options).
 390
 391 -----------------------------------------------------------------------------
 392 -- Hsc phase
 393
 394 run_phase Hsc basename suff input_fn output_fn
 395   = do
 396
 397   -- we add the current directory (i.e. the directory in which
 398   -- the .hs files resides) to the import path, since this is
 399   -- what gcc does, and it's probably what you want.
 400         let current_dir = getdir basename
 401
 402         paths <- readIORef v_Include_paths
 403         writeIORef v_Include_paths (current_dir : paths)
 404
 405   -- figure out where to put the .hi file
 406         ohi    <- readIORef v_Output_hi
 407         hisuf  <- readIORef v_Hi_suf
 408         let hifile = case ohi of
 409                            Nothing -> current_dir ++ {-ToDo: modname!!-}basename
 410                                         ++ hisuf
 411                            Just fn -> fn
 412
 413   -- figure out if the source has changed, for recompilation avoidance.
 414   -- only do this if we're eventually going to generate a .o file.
 415   -- (ToDo: do when generating .hc files too?)
 416   --
 417   -- Setting source_unchanged to "-fsource_unchanged" means that M.o seems
 418   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 419   -- changed (which the compiler itself figures out).
 420   -- Setting source_unchanged to "" tells the compiler that M.o is out of
 421   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 422         do_recomp <- readIORef v_Recomp
 423         todo <- readIORef v_GhcMode
 424         o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
 425         source_unchanged <-
 426           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
 427              then return ""
 428              else do t1 <- getModificationTime (basename ++ '.':suff)
 429                      o_file_exists <- doesFileExist o_file
 430                      if not o_file_exists
 431                         then return ""  -- Need to recompile
 432                         else do t2 <- getModificationTime o_file
 433                                 if t2 > t1
 434                                   then return "-fsource-unchanged"
 435                                   else return ""
 436
 437    -- build a bogus ModSummary to pass to hscMain.
 438         let summary = ModSummary {
 439                         ms_location = error "no loc",
 440                         ms_ppsource = Just (input_fn, error "no fingerprint"),
 441                         ms_imports = error "no imports"
 442                      }
 443
 444   -- get the DynFlags
 445         dyn_flags <- readIORef v_DynFlags
 446
 447   -- run the compiler!
 448         pcs <- initPersistentCompilerState
 449         result <- hscMain dyn_flags{ hscOutName = output_fn }
 450                           (error "no Finder!")
 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 <- getProcessID
 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 -- Compile a single module.
 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 :: Finder                  -- to find modules
 707         -> 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 finder 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                          finder 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)