ghc/compiler/main/DriverPipeline.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- GHC Driver
   4 --
   5 -- (c) The University of Glasgow 2002
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 #include "../includes/config.h"
  10
  11 module DriverPipeline (
  12
  13         -- interfaces for the batch-mode driver
  14    genPipeline, runPipeline, pipeLoop,
  15
  16         -- interfaces for the compilation manager (interpreted/batch-mode)
  17    preprocess, compile, CompResult(..),
  18
  19         -- batch-mode linking interface
  20    doLink,
  21         -- DLL building
  22    doMkDLL
  23   ) where
  24
  25 #include "HsVersions.h"
  26
  27 import Packages
  28 import CmTypes
  29 import GetImports
  30 import DriverState
  31 import DriverUtil
  32 import DriverMkDepend
  33 import DriverPhases
  34 import DriverFlags
  35 import SysTools         ( newTempName, addFilesToClean, getSysMan, copy )
  36 import qualified SysTools
  37 import HscMain
  38 import Finder
  39 import HscTypes
  40 import Outputable
  41 import Module
  42 import ErrUtils
  43 import CmdLineOpts
  44 import Config
  45 import Panic
  46 import Util
  47 import Maybes           ( expectJust )
  48
  49 import ParserCoreUtils ( getCoreModuleName )
  50
  51 #ifdef GHCI
  52 import Time             ( getClockTime )
  53 #endif
  54 import Directory
  55 import System
  56 import IOExts
  57 import Exception
  58
  59 import IO
  60 import Monad
  61 import Maybe
  62
  63 import PackedString
  64
  65 -----------------------------------------------------------------------------
  66 -- genPipeline
  67 --
  68 -- Herein is all the magic about which phases to run in which order, whether
  69 -- the intermediate files should be in TMPDIR or in the current directory,
  70 -- what the suffix of the intermediate files should be, etc.
  71
  72 -- The following compilation pipeline algorithm is fairly hacky.  A
  73 -- better way to do this would be to express the whole compilation as a
  74 -- data flow DAG, where the nodes are the intermediate files and the
  75 -- edges are the compilation phases.  This framework would also work
  76 -- nicely if a haskell dependency generator was included in the
  77 -- driver.
  78
  79 -- It would also deal much more cleanly with compilation phases that
  80 -- generate multiple intermediates, (eg. hsc generates .hc, .hi, and
  81 -- possibly stub files), where some of the output files need to be
  82 -- processed further (eg. the stub files need to be compiled by the C
  83 -- compiler).
  84
  85 -- A cool thing to do would then be to execute the data flow graph
  86 -- concurrently, automatically taking advantage of extra processors on
  87 -- the host machine.  For example, when compiling two Haskell files
  88 -- where one depends on the other, the data flow graph would determine
  89 -- that the C compiler from the first compilation can be overlapped
  90 -- with the hsc compilation for the second file.
  91
  92 data IntermediateFileType
  93   = Temporary
  94   | Persistent
  95   deriving (Eq, Show)
  96
  97 genPipeline
  98    :: GhcMode            -- when to stop
  99    -> String             -- "stop after" flag (for error messages)
 100    -> Bool               -- True => output is persistent
 101    -> HscLang            -- preferred output language for hsc
 102    -> (FilePath, String) -- original filename & its suffix
 103    -> IO [              -- list of phases to run for this file
 104              (Phase,
 105               IntermediateFileType,  -- keep the output from this phase?
 106               String)                -- output file suffix
 107          ]
 108
 109 genPipeline todo stop_flag persistent_output lang (filename,suffix)
 110  = do
 111    split      <- readIORef v_Split_object_files
 112    mangle     <- readIORef v_Do_asm_mangling
 113    keep_hc    <- readIORef v_Keep_hc_files
 114 #ifdef ILX
 115    keep_il    <- readIORef v_Keep_il_files
 116    keep_ilx   <- readIORef v_Keep_ilx_files
 117 #endif
 118    keep_raw_s <- readIORef v_Keep_raw_s_files
 119    keep_s     <- readIORef v_Keep_s_files
 120    osuf       <- readIORef v_Object_suf
 121    hcsuf      <- readIORef v_HC_suf
 122
 123    let
 124    ----------- -----  ----   ---   --   --  -  -  -
 125     start = startPhase suffix
 126
 127       -- special case for mkdependHS: .hspp files go through MkDependHS
 128     start_phase | todo == DoMkDependHS && start == Hsc  = MkDependHS
 129                 | otherwise = start
 130
 131     haskellish = haskellish_suffix suffix
 132     cish = cish_suffix suffix
 133
 134        -- for a .hc file we need to force lang to HscC
 135     real_lang | start_phase == HCc || start_phase == Mangle = HscC
 136               | otherwise                                   = lang
 137
 138    let
 139    ----------- -----  ----   ---   --   --  -  -  -
 140     pipeline = preprocess ++ compile
 141
 142     preprocess
 143         | haskellish = [ Unlit, Cpp, HsPp ]
 144         | otherwise  = [ ]
 145
 146     compile
 147       | todo == DoMkDependHS = [ MkDependHS ]
 148
 149       | cish = [ Cc, As ]
 150
 151       | haskellish =
 152        case real_lang of
 153         HscC    | split && mangle -> [ Hsc, HCc, Mangle, SplitMangle, SplitAs ]
 154                 | mangle          -> [ Hsc, HCc, Mangle, As ]
 155                 | split           -> not_valid
 156                 | otherwise       -> [ Hsc, HCc, As ]
 157
 158         HscCore | split && mangle -> [ Hsc, HCc, Mangle, SplitMangle, SplitAs ]
 159                 | mangle          -> [ Hsc, HCc, Mangle, As ]
 160                 | split           -> not_valid
 161                 | otherwise       -> [ Hsc, HCc, As ]
 162
 163         HscAsm  | split           -> [ Hsc, SplitMangle, SplitAs ]
 164                 | otherwise       -> [ Hsc, As ]
 165
 166         HscJava | split           -> not_valid
 167                 | otherwise       -> error "not implemented: compiling via Java"
 168 #ifdef ILX
 169         HscILX  | split           -> not_valid
 170                 | otherwise       -> [ Hsc, Ilx2Il, Ilasm ]
 171 #endif
 172         HscNothing                -> [ Hsc, HCc ] -- HCc is a dummy stop phase
 173
 174       | otherwise = [ ]  -- just pass this file through to the linker
 175
 176         -- ToDo: this is somewhat cryptic
 177     not_valid = throwDyn (UsageError ("invalid option combination"))
 178
 179     stop_phase = case todo of
 180                         StopBefore As | split -> SplitAs
 181 #ifdef ILX
 182                                       | real_lang == HscILX -> Ilasm
 183 #endif
 184                         StopBefore phase      -> phase
 185                         DoMkDependHS          -> Ln
 186                         DoLink                -> Ln
 187                         DoMkDLL               -> Ln
 188    ----------- -----  ----   ---   --   --  -  -  -
 189
 190         -- this shouldn't happen.
 191    when (start_phase /= Ln && start_phase `notElem` pipeline)
 192         (throwDyn (CmdLineError ("can't find starting phase for "
 193                                  ++ filename)))
 194         -- if we can't find the phase we're supposed to stop before,
 195         -- something has gone wrong.  This test carefully avoids the
 196         -- case where we aren't supposed to do any compilation, because the file
 197         -- is already in linkable form (for example).
 198 --   hPutStrLn stderr (show ((start_phase `elem` pipeline,stop_phase /= Ln,stop_phase `notElem` pipeline), start_phase, stop_phase, pipeline,todo))
 199 --   hFlush stderr
 200    when (start_phase `elem` pipeline &&
 201          (stop_phase /= Ln && stop_phase `notElem` pipeline))
 202         (do
 203           throwDyn (UsageError
 204                     ("flag `" ++ stop_flag
 205                      ++ "' is incompatible with source file `"
 206                      ++ filename ++ "'" ++ show pipeline ++ show stop_phase)))
 207    let
 208         -- .o and .hc suffixes can be overriden by command-line options:
 209       myPhaseInputExt Ln  | Just s <- osuf  = s
 210       myPhaseInputExt HCc | Just s <- hcsuf = s
 211       myPhaseInputExt other                 = phaseInputExt other
 212
 213       annotatePipeline
 214          :: [Phase]             -- raw pipeline
 215          -> Phase               -- phase to stop before
 216          -> [(Phase, IntermediateFileType, String{-file extension-})]
 217       annotatePipeline []     _    = []
 218       annotatePipeline (Ln:_) _    = []
 219       annotatePipeline (phase:next_phase:ps) stop =
 220           (phase, keep_this_output, myPhaseInputExt next_phase)
 221              : annotatePipeline (next_phase:ps) stop
 222           where
 223                 keep_this_output
 224                      | next_phase == stop
 225                      = if persistent_output then Persistent else Temporary
 226                      | otherwise
 227                      = case next_phase of
 228                              Ln -> Persistent
 229                              Mangle | keep_raw_s -> Persistent
 230                              As     | keep_s     -> Persistent
 231                              HCc    | keep_hc    -> Persistent
 232 #ifdef ILX
 233                              Ilx2Il | keep_ilx   -> Persistent
 234                              Ilasm  | keep_il    -> Persistent
 235 #endif
 236                              _other              -> Temporary
 237
 238         -- add information about output files to the pipeline
 239         -- the suffix on an output file is determined by the next phase
 240         -- in the pipeline, so we add linking to the end of the pipeline
 241         -- to force the output from the final phase to be a .o file.
 242
 243       annotated_pipeline = annotatePipeline (pipeline ++ [Ln]) stop_phase
 244
 245       phase_ne p (p1,_,_) = (p1 /= p)
 246    ----------- -----  ----   ---   --   --  -  -  -
 247
 248    return (
 249      takeWhile (phase_ne stop_phase ) $
 250      dropWhile (phase_ne start_phase) $
 251      annotated_pipeline
 252     )
 253
 254
 255 runPipeline
 256   :: [ (Phase, IntermediateFileType, String) ] -- phases to run
 257   -> (String,String)            -- input file
 258   -> Bool                       -- doing linking afterward?
 259   -> Bool                       -- take into account -o when generating output?
 260   -> IO (String, String)        -- return final filename
 261
 262 runPipeline pipeline (input_fn,suffix) do_linking use_ofile
 263   = pipeLoop pipeline (input_fn,suffix) do_linking use_ofile basename suffix
 264   where (basename, _) = splitFilename input_fn
 265
 266 pipeLoop [] input_fn _ _ _ _ = return input_fn
 267 pipeLoop (all_phases@((phase, keep, o_suffix):phases))
 268         (input_fn,real_suff) do_linking use_ofile orig_basename orig_suffix
 269   = do
 270
 271      output_fn <- outputFileName (null phases) keep o_suffix
 272
 273      mbCarryOn <- run_phase phase orig_basename orig_suffix
 274                             input_fn output_fn
 275         -- sometimes we bail out early, eg. when the compiler's recompilation
 276         -- checker has determined that recompilation isn't necessary.
 277      case mbCarryOn of
 278        Nothing -> do
 279               let (_,keep,final_suffix) = last all_phases
 280               ofile <- outputFileName True keep final_suffix
 281               return (ofile, final_suffix)
 282           -- carry on ...
 283        Just fn -> do
 284                 {-
 285                   Check to see whether we've reached the end of the
 286                   pipeline, but did so with an ineffective last stage.
 287                   (i.e., it returned the input_fn as the output filename).
 288
 289                   If we did and the output is persistent, copy the contents
 290                   of input_fn into the file where the pipeline's output is
 291                   expected to end up.
 292                 -}
 293               atEnd <- finalStage (null phases)
 294               when (atEnd && fn == input_fn)
 295                    (copy "Saving away compilation pipeline's output"
 296                          input_fn
 297                          output_fn)
 298               {-
 299                Notice that in order to keep the invariant that we can
 300                determine a compilation pipeline's 'start phase' just
 301                by looking at the input filename, the input filename
 302                to the next stage/phase is associated here with the suffix
 303                of the output file, *even* if it does not have that
 304                suffix in reality.
 305
 306                Why is this important? Because we may run a compilation
 307                pipeline in stages (cf. Main.main.compileFile's two stages),
 308                so when generating the next stage we need to be precise
 309                about what kind of file (=> suffix) is given as input.
 310
 311                [Not having to generate a pipeline in stages seems like
 312                 the right way to go, but I've punted on this for now --sof]
 313
 314               -}
 315               pipeLoop phases (fn, o_suffix) do_linking use_ofile
 316                         orig_basename orig_suffix
 317   where
 318      finalStage lastPhase = do
 319        o_file <- readIORef v_Output_file
 320        return (lastPhase && not do_linking && use_ofile && isJust o_file)
 321
 322      outputFileName last_phase keep suffix
 323         = do o_file <- readIORef v_Output_file
 324              atEnd  <- finalStage last_phase
 325              if atEnd
 326                then case o_file of
 327                        Just s  -> return s
 328                        Nothing -> error "outputFileName"
 329                else if keep == Persistent
 330                            then odir_ify (orig_basename ++ '.':suffix)
 331                            else newTempName suffix
 332
 333 run_phase :: Phase
 334           -> String                -- basename of original input source
 335           -> String                -- its extension
 336           -> FilePath              -- name of file which contains the input to this phase.
 337           -> FilePath              -- where to stick the result.
 338           -> IO (Maybe FilePath)
 339                   -- Nothing => stop the compilation pipeline
 340                   -- Just fn => the result of this phase can be found in 'fn'
 341                   --            (this can either be 'input_fn' or 'output_fn').
 342 -------------------------------------------------------------------------------
 343 -- Unlit phase
 344
 345 run_phase Unlit _basename _suff input_fn output_fn
 346   = do unlit_flags <- getOpts opt_L
 347        -- The -h option passes the file name for unlit to put in a #line directive
 348        SysTools.runUnlit (map SysTools.Option unlit_flags ++
 349                           [ SysTools.Option     "-h"
 350                           , SysTools.Option     input_fn
 351                           , SysTools.FileOption "" input_fn
 352                           , SysTools.FileOption "" output_fn
 353                           ])
 354        return (Just output_fn)
 355
 356 -------------------------------------------------------------------------------
 357 -- Cpp phase
 358
 359 run_phase Cpp basename suff input_fn output_fn
 360   = do src_opts <- getOptionsFromSource input_fn
 361        unhandled_flags <- processArgs dynamic_flags src_opts []
 362        checkProcessArgsResult unhandled_flags basename suff
 363
 364        do_cpp <- dynFlag cppFlag
 365        if not do_cpp then
 366            -- no need to preprocess CPP, just pass input file along
 367            -- to the next phase of the pipeline.
 368           return (Just input_fn)
 369         else do
 370             hscpp_opts      <- getOpts opt_P
 371             hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
 372
 373             cmdline_include_paths <- readIORef v_Include_paths
 374             pkg_include_dirs <- getPackageIncludePath
 375             let include_paths = foldr (\ x xs -> "-I" : x : xs) []
 376                                   (cmdline_include_paths ++ pkg_include_dirs)
 377
 378             verb <- getVerbFlag
 379             (md_c_flags, _) <- machdepCCOpts
 380
 381             SysTools.runCpp ([SysTools.Option verb]
 382                             ++ map SysTools.Option include_paths
 383                             ++ map SysTools.Option hs_src_cpp_opts
 384                             ++ map SysTools.Option hscpp_opts
 385                             ++ map SysTools.Option md_c_flags
 386                             ++ [ SysTools.Option     "-x"
 387                                , SysTools.Option     "c"
 388                                , SysTools.Option     input_fn
 389         -- We hackily use Option instead of FileOption here, so that the file
 390         -- name is not back-slashed on Windows.  cpp is capable of
 391         -- dealing with / in filenames, so it works fine.  Furthermore
 392         -- if we put in backslashes, cpp outputs #line directives
 393         -- with *double* backslashes.   And that in turn means that
 394         -- our error messages get double backslashes in them.
 395         -- In due course we should arrange that the lexer deals
 396         -- with these \\ escapes properly.
 397                                , SysTools.Option     "-o"
 398                                , SysTools.FileOption "" output_fn
 399                                ])
 400             return (Just output_fn)
 401
 402 -------------------------------------------------------------------------------
 403 -- HsPp phase
 404
 405 run_phase HsPp basename suff input_fn output_fn
 406   = do let orig_fn = basename ++ '.':suff
 407        do_pp   <- dynFlag ppFlag
 408        if not do_pp then
 409            -- no need to preprocess, just pass input file along
 410            -- to the next phase of the pipeline.
 411           return (Just input_fn)
 412         else do
 413             hspp_opts      <- getOpts opt_F
 414             hs_src_pp_opts <- readIORef v_Hs_source_pp_opts
 415             SysTools.runPp ( [ SysTools.Option     orig_fn
 416                              , SysTools.Option     input_fn
 417                              , SysTools.FileOption "" output_fn
 418                              ] ++
 419                              map SysTools.Option hs_src_pp_opts ++
 420                              map SysTools.Option hspp_opts
 421                            )
 422             return (Just output_fn)
 423
 424 -----------------------------------------------------------------------------
 425 -- MkDependHS phase
 426
 427 run_phase MkDependHS basename suff input_fn output_fn
 428  = do src <- readFile input_fn
 429       let (import_sources, import_normals, _) = getImports src
 430       let orig_fn = basename ++ '.':suff
 431       deps_sources <- mapM (findDependency True  orig_fn) import_sources
 432       deps_normals <- mapM (findDependency False orig_fn) import_normals
 433       let deps = deps_sources ++ deps_normals
 434
 435       osuf_opt <- readIORef v_Object_suf
 436       let osuf = case osuf_opt of
 437                    Nothing -> phaseInputExt Ln
 438                    Just s  -> s
 439
 440       extra_suffixes <- readIORef v_Dep_suffixes
 441       let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
 442           ofiles = map (\suf -> basename ++ '.':suf) suffixes
 443
 444       objs <- mapM odir_ify ofiles
 445
 446         -- Handle for file that accumulates dependencies
 447       hdl <- readIORef v_Dep_tmp_hdl
 448
 449         -- std dependency of the object(s) on the source file
 450       hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
 451                      escapeSpaces (basename ++ '.':suff))
 452
 453       let genDep (dep, False {- not an hi file -}) =
 454              hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
 455                             escapeSpaces dep)
 456           genDep (dep, True  {- is an hi file -}) = do
 457              hisuf <- readIORef v_Hi_suf
 458              let dep_base = remove_suffix '.' dep
 459                  deps = (dep_base ++ hisuf)
 460                         : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
 461                   -- length objs should be == length deps
 462              sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps)
 463
 464       sequence_ (map genDep [ d | Just d <- deps ])
 465       return (Just output_fn)
 466
 467 -- add the lines to dep_makefile:
 468            -- always:
 469                    -- this.o : this.hs
 470
 471            -- if the dependency is on something other than a .hi file:
 472                    -- this.o this.p_o ... : dep
 473            -- otherwise
 474                    -- if the import is {-# SOURCE #-}
 475                            -- this.o this.p_o ... : dep.hi-boot[-$vers]
 476
 477                    -- else
 478                            -- this.o ...   : dep.hi
 479                            -- this.p_o ... : dep.p_hi
 480                            -- ...
 481
 482            -- (where .o is $osuf, and the other suffixes come from
 483            -- the cmdline -s options).
 484
 485
 486 -----------------------------------------------------------------------------
 487 -- Hsc phase
 488
 489 -- Compilation of a single module, in "legacy" mode (_not_ under
 490 -- the direction of the compilation manager).
 491 run_phase Hsc basename suff input_fn output_fn
 492   = do
 493
 494   -- we add the current directory (i.e. the directory in which
 495   -- the .hs files resides) to the import path, since this is
 496   -- what gcc does, and it's probably what you want.
 497         let current_dir = getdir basename
 498
 499         paths <- readIORef v_Include_paths
 500         writeIORef v_Include_paths (current_dir : paths)
 501
 502   -- figure out which header files to #include in a generated .hc file
 503         c_includes <- getPackageCIncludes
 504         cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
 505
 506         let cc_injects = unlines (map mk_include
 507                                  (c_includes ++ reverse cmdline_includes))
 508             mk_include h_file =
 509                 case h_file of
 510                    '"':_{-"-} -> "#include "++h_file
 511                    '<':_      -> "#include "++h_file
 512                    _          -> "#include \""++h_file++"\""
 513
 514         writeIORef v_HCHeader cc_injects
 515
 516   -- gather the imports and module name
 517         (srcimps,imps,mod_name) <-
 518             if extcoreish_suffix suff
 519              then do
 520                -- no explicit imports in ExtCore input.
 521                m <- getCoreModuleName input_fn
 522                return ([], [], mkModuleName m)
 523              else
 524                getImportsFromFile input_fn
 525
 526   -- build a ModuleLocation to pass to hscMain.
 527         (mod, location')
 528            <- mkHomeModuleLocn mod_name basename (basename ++ '.':suff)
 529
 530   -- take -ohi into account if present
 531         ohi <- readIORef v_Output_hi
 532         let location | Just fn <- ohi = location'{ ml_hi_file = fn }
 533                      | otherwise      = location'
 534
 535   -- figure out if the source has changed, for recompilation avoidance.
 536   -- only do this if we're eventually going to generate a .o file.
 537   -- (ToDo: do when generating .hc files too?)
 538   --
 539   -- Setting source_unchanged to True means that M.o seems
 540   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 541   -- changed (which the compiler itself figures out).
 542   -- Setting source_unchanged to False tells the compiler that M.o is out of
 543   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 544         do_recomp   <- readIORef v_Recomp
 545         todo        <- readIORef v_GhcMode
 546         expl_o_file <- readIORef v_Output_file
 547
 548         let o_file -- if the -o option is given and IT IS THE OBJECT FILE FOR
 549                    -- THIS COMPILATION, then use that to determine if the
 550                    -- source is unchanged.
 551                 | Just x <- expl_o_file, todo == StopBefore Ln  =  x
 552                 | otherwise = expectJust "source_unchanged" (ml_obj_file location)
 553
 554         source_unchanged <-
 555           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
 556              then return False
 557              else do t1 <- getModificationTime (basename ++ '.':suff)
 558                      o_file_exists <- doesFileExist o_file
 559                      if not o_file_exists
 560                         then return False       -- Need to recompile
 561                         else do t2 <- getModificationTime o_file
 562                                 if t2 > t1
 563                                   then return True
 564                                   else return False
 565
 566   -- get the DynFlags
 567         dyn_flags <- getDynFlags
 568
 569         let dyn_flags' = dyn_flags { hscOutName = output_fn,
 570                                      hscStubCOutName = basename ++ "_stub.c",
 571                                      hscStubHOutName = basename ++ "_stub.h",
 572                                      extCoreName = basename ++ ".hcr" }
 573
 574   -- run the compiler!
 575         pcs <- initPersistentCompilerState
 576         result <- hscMain OneShot
 577                           dyn_flags' mod
 578                           location{ ml_hspp_file=Just input_fn }
 579                           source_unchanged
 580                           False
 581                           Nothing        -- no iface
 582                           emptyModuleEnv -- HomeSymbolTable
 583                           emptyModuleEnv -- HomeIfaceTable
 584                           pcs
 585
 586         case result of {
 587
 588             HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
 589
 590             HscNoRecomp pcs details iface -> do { SysTools.touch "Touching object file" o_file
 591                                                 ; return Nothing } ;
 592
 593             HscRecomp pcs details iface stub_h_exists stub_c_exists
 594                       _maybe_interpreted_code -> do
 595
 596                             -- deal with stubs
 597                             maybe_stub_o <- compileStub dyn_flags' stub_c_exists
 598                             case maybe_stub_o of
 599                               Nothing -> return ()
 600                               Just stub_o -> add v_Ld_inputs stub_o
 601                             case hscLang dyn_flags of
 602                               HscNothing -> return Nothing
 603                               _ -> return (Just output_fn)
 604     }
 605
 606 -----------------------------------------------------------------------------
 607 -- Cc phase
 608
 609 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 610 -- way too many hacks, and I can't say I've ever used it anyway.
 611
 612 run_phase cc_phase basename suff input_fn output_fn
 613    | cc_phase == Cc || cc_phase == HCc
 614    = do cc_opts              <- getOpts opt_c
 615         cmdline_include_paths <- readIORef v_Include_paths
 616
 617         let hcc = cc_phase == HCc
 618
 619                 -- add package include paths even if we're just compiling
 620                 -- .c files; this is the Value Add(TM) that using
 621                 -- ghc instead of gcc gives you :)
 622         pkg_include_dirs <- getPackageIncludePath
 623         let include_paths = foldr (\ x xs -> "-I" : x : xs) []
 624                               (cmdline_include_paths ++ pkg_include_dirs)
 625
 626         mangle <- readIORef v_Do_asm_mangling
 627         (md_c_flags, md_regd_c_flags) <- machdepCCOpts
 628
 629         verb <- getVerbFlag
 630
 631         o2 <- readIORef v_minus_o2_for_C
 632         let opt_flag | o2        = "-O2"
 633                      | otherwise = "-O"
 634
 635         pkg_extra_cc_opts <- getPackageExtraCcOpts
 636
 637         split_objs <- readIORef v_Split_object_files
 638         let split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
 639                       | otherwise         = [ ]
 640
 641         excessPrecision <- readIORef v_Excess_precision
 642
 643         -- force the C compiler to interpret this file as C when
 644         -- compiling .hc files, by adding the -x c option.
 645         let langopt
 646                 | cc_phase == HCc = [ SysTools.Option "-x", SysTools.Option "c"]
 647                 | otherwise       = [ ]
 648
 649         SysTools.runCc (langopt ++
 650                         [ SysTools.FileOption "" input_fn
 651                         , SysTools.Option "-o"
 652                         , SysTools.FileOption "" output_fn
 653                         ]
 654                        ++ map SysTools.Option (
 655                           md_c_flags
 656                        ++ (if cc_phase == HCc && mangle
 657                              then md_regd_c_flags
 658                              else [])
 659                        ++ [ verb, "-S", "-Wimplicit", opt_flag ]
 660                        ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 661                        ++ cc_opts
 662                        ++ split_opt
 663                        ++ (if excessPrecision then [] else [ "-ffloat-store" ])
 664                        ++ include_paths
 665                        ++ pkg_extra_cc_opts
 666                        ))
 667         return (Just output_fn)
 668
 669         -- ToDo: postprocess the output from gcc
 670
 671 -----------------------------------------------------------------------------
 672 -- Mangle phase
 673
 674 run_phase Mangle _basename _suff input_fn output_fn
 675   = do mangler_opts <- getOpts opt_m
 676        machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM)
 677                        then do n_regs <- dynFlag stolen_x86_regs
 678                                return [ show n_regs ]
 679                        else return []
 680
 681        SysTools.runMangle (map SysTools.Option mangler_opts
 682                           ++ [ SysTools.FileOption "" input_fn
 683                              , SysTools.FileOption "" output_fn
 684                              ]
 685                           ++ map SysTools.Option machdep_opts)
 686        return (Just output_fn)
 687
 688 -----------------------------------------------------------------------------
 689 -- Splitting phase
 690
 691 run_phase SplitMangle _basename _suff input_fn output_fn
 692   = do  -- tmp_pfx is the prefix used for the split .s files
 693         -- We also use it as the file to contain the no. of split .s files (sigh)
 694         split_s_prefix <- SysTools.newTempName "split"
 695         let n_files_fn = split_s_prefix
 696
 697         SysTools.runSplit [ SysTools.FileOption "" input_fn
 698                           , SysTools.FileOption "" split_s_prefix
 699                           , SysTools.FileOption "" n_files_fn
 700                           ]
 701
 702         -- Save the number of split files for future references
 703         s <- readFile n_files_fn
 704         let n_files = read s :: Int
 705         writeIORef v_Split_info (split_s_prefix, n_files)
 706
 707         -- Remember to delete all these files
 708         addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
 709                         | n <- [1..n_files]]
 710
 711         return (Just output_fn)
 712
 713 -----------------------------------------------------------------------------
 714 -- As phase
 715
 716 run_phase As _basename _suff input_fn output_fn
 717   = do  as_opts               <- getOpts opt_a
 718         cmdline_include_paths <- readIORef v_Include_paths
 719
 720         SysTools.runAs (map SysTools.Option as_opts
 721                        ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
 722                        ++ [ SysTools.Option "-c"
 723                           , SysTools.FileOption "" input_fn
 724                           , SysTools.Option "-o"
 725                           , SysTools.FileOption "" output_fn
 726                           ])
 727         return (Just output_fn)
 728
 729 run_phase SplitAs basename _suff _input_fn output_fn
 730   = do  as_opts <- getOpts opt_a
 731
 732         (split_s_prefix, n) <- readIORef v_Split_info
 733
 734         odir <- readIORef v_Output_dir
 735         let real_odir = case odir of
 736                                 Nothing -> basename ++ "_split"
 737                                 Just d  -> d
 738
 739         let assemble_file n
 740               = do  let input_s  = split_s_prefix ++ "__" ++ show n ++ ".s"
 741                     let output_o = newdir real_odir
 742                                         (basename ++ "__" ++ show n ++ ".o")
 743                     real_o <- osuf_ify output_o
 744                     SysTools.runAs (map SysTools.Option as_opts ++
 745                                     [ SysTools.Option "-c"
 746                                     , SysTools.Option "-o"
 747                                     , SysTools.FileOption "" real_o
 748                                     , SysTools.FileOption "" input_s
 749                                     ])
 750
 751         mapM_ assemble_file [1..n]
 752         return (Just output_fn)
 753
 754 #ifdef ILX
 755 -----------------------------------------------------------------------------
 756 -- Ilx2Il phase
 757 -- Run ilx2il over the ILX output, getting an IL file
 758
 759 run_phase Ilx2Il _basename _suff input_fn output_fn
 760   = do  ilx2il_opts <- getOpts opt_I
 761         SysTools.runIlx2il (map SysTools.Option ilx2il_opts
 762                            ++ [ SysTools.Option "--no-add-suffix-to-assembly",
 763                                 SysTools.Option "mscorlib",
 764                                 SysTools.Option "-o",
 765                                 SysTools.FileOption "" output_fn,
 766                                 SysTools.FileOption "" input_fn ])
 767         return (Just output_fn)
 768
 769 -----------------------------------------------------------------------------
 770 -- Ilasm phase
 771 -- Run ilasm over the IL, getting a DLL
 772
 773 run_phase Ilasm _basename _suff input_fn output_fn
 774   = do  ilasm_opts <- getOpts opt_i
 775         SysTools.runIlasm (map SysTools.Option ilasm_opts
 776                            ++ [ SysTools.Option "/QUIET",
 777                                 SysTools.Option "/DLL",
 778                                 SysTools.FileOption "/OUT=" output_fn,
 779                                 SysTools.FileOption "" input_fn ])
 780         return (Just output_fn)
 781
 782 #endif -- ILX
 783
 784 -----------------------------------------------------------------------------
 785 -- MoveBinary sort-of-phase
 786 -- After having produced a binary, move it somewhere else and generate a
 787 -- wrapper script calling the binary. Currently, we need this only in
 788 -- a parallel way (i.e. in GUM), because PVM expects the binary in a
 789 -- central directory.
 790 -- This is called from doLink below, after linking. I haven't made it
 791 -- a separate phase to minimise interfering with other modules, and
 792 -- we don't need the generality of a phase (MoveBinary is always
 793 -- done after linking and makes only sense in a parallel setup)   -- HWL
 794
 795 run_phase_MoveBinary input_fn
 796   = do
 797         sysMan   <- getSysMan
 798         pvm_root <- getEnv "PVM_ROOT"
 799         pvm_arch <- getEnv "PVM_ARCH"
 800         let
 801            pvm_executable_base = "=" ++ input_fn
 802            pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
 803         -- nuke old binary; maybe use configur'ed names for cp and rm?
 804         system ("rm -f " ++ pvm_executable)
 805         -- move the newly created binary into PVM land
 806         system ("cp -p " ++ input_fn ++ " " ++ pvm_executable)
 807         -- generate a wrapper script for running a parallel prg under PVM
 808         writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
 809         return True
 810
 811 -- generates a Perl skript starting a parallel prg under PVM
 812 mk_pvm_wrapper_script :: String -> String -> String -> String
 813 mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
 814  [
 815   "eval 'exec perl -S $0 ${1+\"$@\"}'",
 816   "  if $running_under_some_shell;",
 817   "# =!=!=!=!=!=!=!=!=!=!=!",
 818   "# This script is automatically generated: DO NOT EDIT!!!",
 819   "# Generated by Glasgow Haskell Compiler",
 820   "# ngoqvam choHbogh vaj' vIHoHnISbej !!!!",
 821   "#",
 822   "$pvm_executable      = '" ++ pvm_executable ++ "';",
 823   "$pvm_executable_base = '" ++ pvm_executable_base ++ "';",
 824   "$SysMan = '" ++ sysMan ++ "';",
 825   "",
 826   {- ToDo: add the magical shortcuts again iff we actually use them -- HWL
 827   "# first, some magical shortcuts to run "commands" on the binary",
 828   "# (which is hidden)",
 829   "if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {",
 830   "    local($cmd) = $1;",
 831   "    system("$cmd $pvm_executable");",
 832   "    exit(0); # all done",
 833   "}", -}
 834   "",
 835   "# Now, run the real binary; process the args first",
 836   "$ENV{'PE'} = $pvm_executable_base;", --  ++ pvm_executable_base,
 837   "$debug = '';",
 838   "$nprocessors = 0; # the default: as many PEs as machines in PVM config",
 839   "@nonPVM_args = ();",
 840   "$in_RTS_args = 0;",
 841   "",
 842   "args: while ($a = shift(@ARGV)) {",
 843   "    if ( $a eq '+RTS' ) {",
 844   "     $in_RTS_args = 1;",
 845   "    } elsif ( $a eq '-RTS' ) {",
 846   "     $in_RTS_args = 0;",
 847   "    }",
 848   "    if ( $a eq '-d' && $in_RTS_args ) {",
 849   "     $debug = '-';",
 850   "    } elsif ( $a =~ /^-qN(\\d+)/ && $in_RTS_args ) {",
 851   "     $nprocessors = $1;",
 852   "    } elsif ( $a =~ /^-qp(\\d+)/ && $in_RTS_args ) {",
 853   "     $nprocessors = $1;",
 854   "    } else {",
 855   "     push(@nonPVM_args, $a);",
 856   "    }",
 857   "}",
 858   "",
 859   "local($return_val) = 0;",
 860   "# Start the parallel execution by calling SysMan",
 861   "system(\"$SysMan $debug $pvm_executable $nprocessors @nonPVM_args\");",
 862   "$return_val = $?;",
 863   "# ToDo: fix race condition moving files and flushing them!!",
 864   "system(\"cp $ENV{'HOME'}/$pvm_executable_base.???.gr .\") if -f \"$ENV{'HOME'}/$pvm_executable_base.002.gr\";",
 865   "exit($return_val);"
 866  ]
 867
 868 -----------------------------------------------------------------------------
 869 -- Complain about non-dynamic flags in OPTIONS pragmas
 870
 871 checkProcessArgsResult flags basename suff
 872   = do when (notNull flags) (throwDyn (ProgramError (
 873            basename ++ "." ++ suff
 874            ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t"
 875            ++ unwords flags)) (ExitFailure 1))
 876
 877 -----------------------------------------------------------------------------
 878 -- Linking
 879
 880 doLink :: [String] -> IO ()
 881 doLink o_files = do
 882     verb       <- getVerbFlag
 883     static     <- readIORef v_Static
 884     no_hs_main <- readIORef v_NoHsMain
 885
 886     o_file <- readIORef v_Output_file
 887     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 888
 889     pkg_lib_paths <- getPackageLibraryPath
 890     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 891
 892     lib_paths <- readIORef v_Library_paths
 893     let lib_path_opts = map ("-L"++) lib_paths
 894
 895     pkg_libs <- getPackageLibraries
 896     let imp          = if static then "" else "_imp"
 897         pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
 898
 899     libs <- readIORef v_Cmdline_libraries
 900     let lib_opts = map ("-l"++) (reverse libs)
 901          -- reverse because they're added in reverse order from the cmd line
 902
 903 #ifdef darwin_TARGET_OS
 904     pkg_framework_paths <- getPackageFrameworkPath
 905     let pkg_framework_path_opts = map ("-F"++) pkg_framework_paths
 906
 907     framework_paths <- readIORef v_Framework_paths
 908     let framework_path_opts = map ("-F"++) framework_paths
 909
 910     pkg_frameworks <- getPackageFrameworks
 911     let pkg_framework_opts = map ("-framework " ++) pkg_frameworks
 912
 913     frameworks <- readIORef v_Cmdline_frameworks
 914     let framework_opts = map ("-framework "++) (reverse frameworks)
 915          -- reverse because they're added in reverse order from the cmd line
 916 #endif
 917
 918     pkg_extra_ld_opts <- getPackageExtraLdOpts
 919
 920         -- probably _stub.o files
 921     extra_ld_inputs <- readIORef v_Ld_inputs
 922
 923         -- opts from -optl-<blah>
 924     extra_ld_opts <- getStaticOpts v_Opt_l
 925
 926     rts_pkg <- getPackageDetails ["rts"]
 927     std_pkg <- getPackageDetails ["std"]
 928     let extra_os = if static || no_hs_main
 929                    then []
 930                    else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
 931                           head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
 932
 933     (md_c_flags, _) <- machdepCCOpts
 934     SysTools.runLink ( [ SysTools.Option verb
 935                        , SysTools.Option "-o"
 936                        , SysTools.FileOption "" output_fn
 937                        ]
 938                       ++ map SysTools.Option (
 939                          md_c_flags
 940                       ++ o_files
 941                       ++ extra_os
 942                       ++ extra_ld_inputs
 943                       ++ lib_path_opts
 944                       ++ lib_opts
 945 #ifdef darwin_TARGET_OS
 946                       ++ framework_path_opts
 947                       ++ framework_opts
 948 #endif
 949                       ++ pkg_lib_path_opts
 950                       ++ pkg_lib_opts
 951 #ifdef darwin_TARGET_OS
 952                       ++ pkg_framework_path_opts
 953                       ++ pkg_framework_opts
 954 #endif
 955                       ++ pkg_extra_ld_opts
 956                       ++ extra_ld_opts
 957                       ++ if static && not no_hs_main then
 958                             [ "-u", prefixUnderscore "Main_zdmain_closure"]
 959                          else []))
 960
 961     -- parallel only: move binary to another dir -- HWL
 962     ways_ <- readIORef v_Ways
 963     when (WayPar `elem` ways_)
 964          (do success <- run_phase_MoveBinary output_fn
 965              if success then return ()
 966                         else throwDyn (InstallationError ("cannot move binary to PVM dir")))
 967
 968 -----------------------------------------------------------------------------
 969 -- Making a DLL (only for Win32)
 970
 971 doMkDLL :: [String] -> IO ()
 972 doMkDLL o_files = do
 973     verb       <- getVerbFlag
 974     static     <- readIORef v_Static
 975     no_hs_main <- readIORef v_NoHsMain
 976
 977     o_file <- readIORef v_Output_file
 978     let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
 979
 980     pkg_lib_paths <- getPackageLibraryPath
 981     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 982
 983     lib_paths <- readIORef v_Library_paths
 984     let lib_path_opts = map ("-L"++) lib_paths
 985
 986     pkg_libs <- getPackageLibraries
 987     let imp = if static then "" else "_imp"
 988         pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
 989
 990     libs <- readIORef v_Cmdline_libraries
 991     let lib_opts = map ("-l"++) (reverse libs)
 992          -- reverse because they're added in reverse order from the cmd line
 993
 994     pkg_extra_ld_opts <- getPackageExtraLdOpts
 995
 996         -- probably _stub.o files
 997     extra_ld_inputs <- readIORef v_Ld_inputs
 998
 999         -- opts from -optdll-<blah>
1000     extra_ld_opts <- getStaticOpts v_Opt_dll
1001
1002     rts_pkg <- getPackageDetails ["rts"]
1003     std_pkg <- getPackageDetails ["std"]
1004
1005     let extra_os = if static || no_hs_main
1006                    then []
1007                    else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
1008                           head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
1009
1010     (md_c_flags, _) <- machdepCCOpts
1011     SysTools.runMkDLL
1012          ([ SysTools.Option verb
1013           , SysTools.Option "-o"
1014           , SysTools.FileOption "" output_fn
1015           ]
1016          ++ map SysTools.Option (
1017             md_c_flags
1018          ++ o_files
1019          ++ extra_os
1020          ++ [ "--target=i386-mingw32" ]
1021          ++ extra_ld_inputs
1022          ++ lib_path_opts
1023          ++ lib_opts
1024          ++ pkg_lib_path_opts
1025          ++ pkg_lib_opts
1026          ++ pkg_extra_ld_opts
1027          ++ (if "--def" `elem` (concatMap words extra_ld_opts)
1028                then [ "" ]
1029                else [ "--export-all" ])
1030          ++ extra_ld_opts
1031         ))
1032
1033 -----------------------------------------------------------------------------
1034 -- Just preprocess a file, put the result in a temp. file (used by the
1035 -- compilation manager during the summary phase).
1036
1037 preprocess :: FilePath -> IO FilePath
1038 preprocess filename =
1039   ASSERT(haskellish_src_file filename)
1040   do restoreDynFlags    -- Restore to state of last save
1041      let fInfo = (filename, getFileSuffix filename)
1042      pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False
1043                              defaultHscLang fInfo
1044      (fn,_)   <- runPipeline pipeline fInfo
1045                              False{-no linking-} False{-no -o flag-}
1046      return fn
1047
1048 -----------------------------------------------------------------------------
1049 -- Compile a single module, under the control of the compilation manager.
1050 --
1051 -- This is the interface between the compilation manager and the
1052 -- compiler proper (hsc), where we deal with tedious details like
1053 -- reading the OPTIONS pragma from the source file, and passing the
1054 -- output of hsc through the C compiler.
1055
1056 -- The driver sits between 'compile' and 'hscMain', translating calls
1057 -- to the former into calls to the latter, and results from the latter
1058 -- into results from the former.  It does things like preprocessing
1059 -- the .hs file if necessary, and compiling up the .stub_c files to
1060 -- generate Linkables.
1061
1062 -- NB.  No old interface can also mean that the source has changed.
1063
1064 compile :: GhciMode                -- distinguish batch from interactive
1065         -> ModSummary              -- summary, including source
1066         -> Bool                    -- True <=> source unchanged
1067         -> Bool                    -- True <=> have object
1068         -> Maybe ModIface          -- old interface, if available
1069         -> HomeSymbolTable         -- for home module ModDetails
1070         -> HomeIfaceTable          -- for home module Ifaces
1071         -> PersistentCompilerState -- persistent compiler state
1072         -> IO CompResult
1073
1074 data CompResult
1075    = CompOK   PersistentCompilerState   -- updated PCS
1076               ModDetails  -- new details (HST additions)
1077               ModIface    -- new iface   (HIT additions)
1078               (Maybe Linkable)
1079                        -- new code; Nothing => compilation was not reqd
1080                        -- (old code is still valid)
1081
1082    | CompErrs PersistentCompilerState   -- updated PCS
1083
1084
1085 compile ghci_mode summary source_unchanged have_object
1086         old_iface hst hit pcs = do
1087    dyn_flags <- restoreDynFlags         -- Restore to the state of the last save
1088
1089
1090    showPass dyn_flags
1091         (showSDoc (text "Compiling" <+> ppr (modSummaryName summary)))
1092
1093    let verb       = verbosity dyn_flags
1094    let location   = ms_location summary
1095    let input_fn   = expectJust "compile:hs" (ml_hs_file location)
1096    let input_fnpp = expectJust "compile:hspp" (ml_hspp_file location)
1097
1098    when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
1099
1100    opts <- getOptionsFromSource input_fnpp
1101    processArgs dynamic_flags opts []
1102    dyn_flags <- getDynFlags
1103
1104    let hsc_lang      = hscLang dyn_flags
1105        (basename, _) = splitFilename input_fn
1106
1107    keep_hc <- readIORef v_Keep_hc_files
1108 #ifdef ILX
1109    keep_il <- readIORef v_Keep_il_files
1110 #endif
1111    keep_s  <- readIORef v_Keep_s_files
1112
1113    output_fn <-
1114         case hsc_lang of
1115            HscAsm  | keep_s    -> return (basename ++ '.':phaseInputExt As)
1116                    | otherwise -> newTempName (phaseInputExt As)
1117            HscC    | keep_hc   -> return (basename ++ '.':phaseInputExt HCc)
1118                    | otherwise -> newTempName (phaseInputExt HCc)
1119            HscJava             -> newTempName "java" -- ToDo
1120 #ifdef ILX
1121            HscILX  | keep_il   -> return (basename ++ '.':phaseInputExt Ilasm)
1122                    | otherwise -> newTempName (phaseInputExt Ilx2Il)
1123 #endif
1124            HscInterpreted      -> return (error "no output file")
1125            HscNothing          -> return (error "no output file")
1126
1127    let dyn_flags' = dyn_flags { hscOutName = output_fn,
1128                                 hscStubCOutName = basename ++ "_stub.c",
1129                                 hscStubHOutName = basename ++ "_stub.h",
1130                                 extCoreName = basename ++ ".hcr" }
1131
1132    -- figure out which header files to #include in a generated .hc file
1133    c_includes <- getPackageCIncludes
1134    cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
1135
1136    let cc_injects = unlines (map mk_include
1137                                  (c_includes ++ reverse cmdline_includes))
1138        mk_include h_file =
1139         case h_file of
1140            '"':_{-"-} -> "#include "++h_file
1141            '<':_      -> "#include "++h_file
1142            _          -> "#include \""++h_file++"\""
1143
1144    writeIORef v_HCHeader cc_injects
1145
1146    -- -no-recomp should also work with --make
1147    do_recomp <- readIORef v_Recomp
1148    let source_unchanged' = source_unchanged && do_recomp
1149
1150    -- run the compiler
1151    hsc_result <- hscMain ghci_mode dyn_flags'
1152                          (ms_mod summary) location
1153                          source_unchanged' have_object old_iface hst hit pcs
1154
1155    case hsc_result of
1156       HscFail pcs -> return (CompErrs pcs)
1157
1158       HscNoRecomp pcs details iface -> return (CompOK pcs details iface Nothing)
1159
1160       HscRecomp pcs details iface
1161         stub_h_exists stub_c_exists maybe_interpreted_code -> do
1162            let
1163            maybe_stub_o <- compileStub dyn_flags' stub_c_exists
1164            let stub_unlinked = case maybe_stub_o of
1165                                   Nothing -> []
1166                                   Just stub_o -> [ DotO stub_o ]
1167
1168            (hs_unlinked, unlinked_time) <-
1169              case hsc_lang of
1170
1171                 -- in interpreted mode, just return the compiled code
1172                 -- as our "unlinked" object.
1173                 HscInterpreted ->
1174                     case maybe_interpreted_code of
1175 #ifdef GHCI
1176                        Just (bcos,itbl_env) -> do tm <- getClockTime
1177                                                   return ([BCOs bcos itbl_env], tm)
1178 #endif
1179                        Nothing -> panic "compile: no interpreted code"
1180
1181                 -- we're in batch mode: finish the compilation pipeline.
1182                 _other -> do pipe <- genPipeline (StopBefore Ln) "" True
1183                                         hsc_lang (output_fn, getFileSuffix output_fn)
1184                              -- runPipeline takes input_fn so it can split off
1185                              -- the base name and use it as the base of
1186                              -- the output object file.
1187                              let (basename, suffix) = splitFilename input_fn
1188                              (o_file,_) <-
1189                                  pipeLoop pipe (output_fn, getFileSuffix output_fn)
1190                                                False False
1191                                                basename suffix
1192                              o_time <- getModificationTime o_file
1193                              return ([DotO o_file], o_time)
1194
1195            let linkable = LM unlinked_time (modSummaryName summary)
1196                              (hs_unlinked ++ stub_unlinked)
1197
1198            return (CompOK pcs details iface (Just linkable))
1199
1200
1201 -----------------------------------------------------------------------------
1202 -- stub .h and .c files (for foreign export support)
1203
1204 compileStub dflags stub_c_exists
1205   | not stub_c_exists = return Nothing
1206   | stub_c_exists = do
1207         -- compile the _stub.c file w/ gcc
1208         let stub_c = hscStubCOutName dflags
1209         pipeline   <- genPipeline (StopBefore Ln) "" True defaultHscLang (stub_c,"c")
1210         (stub_o,_) <- runPipeline pipeline (stub_c,"c") False{-no linking-}
1211                                   False{-no -o option-}
1212         return (Just stub_o)