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