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 run_phase HsPp basename suff input_fn output_fn
 405   = do src_opts <- getOptionsFromSource input_fn
 406        unhandled_flags <- processArgs dynamic_flags src_opts []
 407        checkProcessArgsResult unhandled_flags basename suff
 408
 409        let orig_fn = basename ++ '.':suff
 410        do_pp   <- dynFlag ppFlag
 411        if not do_pp then
 412            -- no need to preprocess, just pass input file along
 413            -- to the next phase of the pipeline.
 414           return (Just input_fn)
 415         else do
 416             hspp_opts      <- getOpts opt_F
 417             hs_src_pp_opts <- readIORef v_Hs_source_pp_opts
 418             SysTools.runPp ( [ SysTools.Option     orig_fn
 419                              , SysTools.Option     input_fn
 420                              , SysTools.FileOption "" output_fn
 421                              ] ++
 422                              map SysTools.Option hs_src_pp_opts ++
 423                              map SysTools.Option hspp_opts
 424                            )
 425             return (Just output_fn)
 426
 427 -----------------------------------------------------------------------------
 428 -- MkDependHS phase
 429
 430 run_phase MkDependHS basename suff input_fn output_fn
 431  = do src <- readFile input_fn
 432       let (import_sources, import_normals, _) = getImports src
 433       let orig_fn = basename ++ '.':suff
 434       deps_sources <- mapM (findDependency True  orig_fn) import_sources
 435       deps_normals <- mapM (findDependency False orig_fn) import_normals
 436       let deps = deps_sources ++ deps_normals
 437
 438       osuf_opt <- readIORef v_Object_suf
 439       let osuf = case osuf_opt of
 440                    Nothing -> phaseInputExt Ln
 441                    Just s  -> s
 442
 443       extra_suffixes <- readIORef v_Dep_suffixes
 444       let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
 445           ofiles = map (\suf -> basename ++ '.':suf) suffixes
 446
 447       objs <- mapM odir_ify ofiles
 448
 449         -- Handle for file that accumulates dependencies
 450       hdl <- readIORef v_Dep_tmp_hdl
 451
 452         -- std dependency of the object(s) on the source file
 453       hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
 454                      escapeSpaces (basename ++ '.':suff))
 455
 456       let genDep (dep, False {- not an hi file -}) =
 457              hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
 458                             escapeSpaces dep)
 459           genDep (dep, True  {- is an hi file -}) = do
 460              hisuf <- readIORef v_Hi_suf
 461              let dep_base = remove_suffix '.' dep
 462                  deps = (dep_base ++ hisuf)
 463                         : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
 464                   -- length objs should be == length deps
 465              sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps)
 466
 467       sequence_ (map genDep [ d | Just d <- deps ])
 468       return (Just output_fn)
 469
 470 -- add the lines to dep_makefile:
 471            -- always:
 472                    -- this.o : this.hs
 473
 474            -- if the dependency is on something other than a .hi file:
 475                    -- this.o this.p_o ... : dep
 476            -- otherwise
 477                    -- if the import is {-# SOURCE #-}
 478                            -- this.o this.p_o ... : dep.hi-boot[-$vers]
 479
 480                    -- else
 481                            -- this.o ...   : dep.hi
 482                            -- this.p_o ... : dep.p_hi
 483                            -- ...
 484
 485            -- (where .o is $osuf, and the other suffixes come from
 486            -- the cmdline -s options).
 487
 488
 489 -----------------------------------------------------------------------------
 490 -- Hsc phase
 491
 492 -- Compilation of a single module, in "legacy" mode (_not_ under
 493 -- the direction of the compilation manager).
 494 run_phase Hsc basename suff input_fn output_fn
 495   = do
 496
 497   -- we add the current directory (i.e. the directory in which
 498   -- the .hs files resides) to the import path, since this is
 499   -- what gcc does, and it's probably what you want.
 500         let current_dir = getdir basename
 501
 502         paths <- readIORef v_Include_paths
 503         writeIORef v_Include_paths (current_dir : paths)
 504
 505   -- figure out which header files to #include in a generated .hc file
 506         c_includes <- getPackageCIncludes
 507         cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
 508
 509         let cc_injects = unlines (map mk_include
 510                                  (c_includes ++ reverse cmdline_includes))
 511             mk_include h_file =
 512                 case h_file of
 513                    '"':_{-"-} -> "#include "++h_file
 514                    '<':_      -> "#include "++h_file
 515                    _          -> "#include \""++h_file++"\""
 516
 517         writeIORef v_HCHeader cc_injects
 518
 519   -- gather the imports and module name
 520         (srcimps,imps,mod_name) <-
 521             if extcoreish_suffix suff
 522              then do
 523                -- no explicit imports in ExtCore input.
 524                m <- getCoreModuleName input_fn
 525                return ([], [], mkModuleName m)
 526              else
 527                getImportsFromFile input_fn
 528
 529   -- build a ModuleLocation to pass to hscMain.
 530         (mod, location')
 531            <- mkHomeModuleLocn mod_name basename (basename ++ '.':suff)
 532
 533   -- take -ohi into account if present
 534         ohi <- readIORef v_Output_hi
 535         let location | Just fn <- ohi = location'{ ml_hi_file = fn }
 536                      | otherwise      = location'
 537
 538   -- figure out if the source has changed, for recompilation avoidance.
 539   -- only do this if we're eventually going to generate a .o file.
 540   -- (ToDo: do when generating .hc files too?)
 541   --
 542   -- Setting source_unchanged to True means that M.o seems
 543   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 544   -- changed (which the compiler itself figures out).
 545   -- Setting source_unchanged to False tells the compiler that M.o is out of
 546   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 547         do_recomp   <- readIORef v_Recomp
 548         todo        <- readIORef v_GhcMode
 549         expl_o_file <- readIORef v_Output_file
 550
 551         let o_file -- if the -o option is given and IT IS THE OBJECT FILE FOR
 552                    -- THIS COMPILATION, then use that to determine if the
 553                    -- source is unchanged.
 554                 | Just x <- expl_o_file, todo == StopBefore Ln  =  x
 555                 | otherwise = expectJust "source_unchanged" (ml_obj_file location)
 556
 557         source_unchanged <-
 558           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
 559              then return False
 560              else do t1 <- getModificationTime (basename ++ '.':suff)
 561                      o_file_exists <- doesFileExist o_file
 562                      if not o_file_exists
 563                         then return False       -- Need to recompile
 564                         else do t2 <- getModificationTime o_file
 565                                 if t2 > t1
 566                                   then return True
 567                                   else return False
 568
 569   -- get the DynFlags
 570         dyn_flags <- getDynFlags
 571
 572         let dyn_flags' = dyn_flags { hscOutName = output_fn,
 573                                      hscStubCOutName = basename ++ "_stub.c",
 574                                      hscStubHOutName = basename ++ "_stub.h",
 575                                      extCoreName = basename ++ ".hcr" }
 576
 577   -- run the compiler!
 578         pcs <- initPersistentCompilerState
 579         result <- hscMain OneShot
 580                           dyn_flags' mod
 581                           location{ ml_hspp_file=Just input_fn }
 582                           source_unchanged
 583                           False
 584                           Nothing        -- no iface
 585                           emptyModuleEnv -- HomeSymbolTable
 586                           emptyModuleEnv -- HomeIfaceTable
 587                           pcs
 588
 589         case result of {
 590
 591             HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
 592
 593             HscNoRecomp pcs details iface -> do { SysTools.touch "Touching object file" o_file
 594                                                 ; return Nothing } ;
 595
 596             HscRecomp pcs details iface stub_h_exists stub_c_exists
 597                       _maybe_interpreted_code -> do
 598
 599                             -- deal with stubs
 600                             maybe_stub_o <- compileStub dyn_flags' stub_c_exists
 601                             case maybe_stub_o of
 602                               Nothing -> return ()
 603                               Just stub_o -> add v_Ld_inputs stub_o
 604                             case hscLang dyn_flags of
 605                               HscNothing -> return Nothing
 606                               _ -> return (Just output_fn)
 607     }
 608
 609 -----------------------------------------------------------------------------
 610 -- Cc phase
 611
 612 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 613 -- way too many hacks, and I can't say I've ever used it anyway.
 614
 615 run_phase cc_phase basename suff input_fn output_fn
 616    | cc_phase == Cc || cc_phase == HCc
 617    = do cc_opts              <- getOpts opt_c
 618         cmdline_include_paths <- readIORef v_Include_paths
 619
 620         let hcc = cc_phase == HCc
 621
 622                 -- add package include paths even if we're just compiling
 623                 -- .c files; this is the Value Add(TM) that using
 624                 -- ghc instead of gcc gives you :)
 625         pkg_include_dirs <- getPackageIncludePath
 626         let include_paths = foldr (\ x xs -> "-I" : x : xs) []
 627                               (cmdline_include_paths ++ pkg_include_dirs)
 628
 629         mangle <- readIORef v_Do_asm_mangling
 630         (md_c_flags, md_regd_c_flags) <- machdepCCOpts
 631
 632         verb <- getVerbFlag
 633
 634         o2 <- readIORef v_minus_o2_for_C
 635         let opt_flag | o2        = "-O2"
 636                      | otherwise = "-O"
 637
 638         pkg_extra_cc_opts <- getPackageExtraCcOpts
 639
 640         split_objs <- readIORef v_Split_object_files
 641         let split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
 642                       | otherwise         = [ ]
 643
 644         excessPrecision <- readIORef v_Excess_precision
 645
 646         -- force the C compiler to interpret this file as C when
 647         -- compiling .hc files, by adding the -x c option.
 648         let langopt
 649                 | cc_phase == HCc = [ SysTools.Option "-x", SysTools.Option "c"]
 650                 | otherwise       = [ ]
 651
 652         SysTools.runCc (langopt ++
 653                         [ SysTools.FileOption "" input_fn
 654                         , SysTools.Option "-o"
 655                         , SysTools.FileOption "" output_fn
 656                         ]
 657                        ++ map SysTools.Option (
 658                           md_c_flags
 659                        ++ (if cc_phase == HCc && mangle
 660                              then md_regd_c_flags
 661                              else [])
 662                        ++ [ verb, "-S", "-Wimplicit", opt_flag ]
 663                        ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 664                        ++ cc_opts
 665                        ++ split_opt
 666                        ++ (if excessPrecision then [] else [ "-ffloat-store" ])
 667                        ++ include_paths
 668                        ++ pkg_extra_cc_opts
 669                        ))
 670         return (Just output_fn)
 671
 672         -- ToDo: postprocess the output from gcc
 673
 674 -----------------------------------------------------------------------------
 675 -- Mangle phase
 676
 677 run_phase Mangle _basename _suff input_fn output_fn
 678   = do mangler_opts <- getOpts opt_m
 679        machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM)
 680                        then do n_regs <- dynFlag stolen_x86_regs
 681                                return [ show n_regs ]
 682                        else return []
 683
 684        SysTools.runMangle (map SysTools.Option mangler_opts
 685                           ++ [ SysTools.FileOption "" input_fn
 686                              , SysTools.FileOption "" output_fn
 687                              ]
 688                           ++ map SysTools.Option machdep_opts)
 689        return (Just output_fn)
 690
 691 -----------------------------------------------------------------------------
 692 -- Splitting phase
 693
 694 run_phase SplitMangle _basename _suff input_fn output_fn
 695   = do  -- tmp_pfx is the prefix used for the split .s files
 696         -- We also use it as the file to contain the no. of split .s files (sigh)
 697         split_s_prefix <- SysTools.newTempName "split"
 698         let n_files_fn = split_s_prefix
 699
 700         SysTools.runSplit [ SysTools.FileOption "" input_fn
 701                           , SysTools.FileOption "" split_s_prefix
 702                           , SysTools.FileOption "" n_files_fn
 703                           ]
 704
 705         -- Save the number of split files for future references
 706         s <- readFile n_files_fn
 707         let n_files = read s :: Int
 708         writeIORef v_Split_info (split_s_prefix, n_files)
 709
 710         -- Remember to delete all these files
 711         addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
 712                         | n <- [1..n_files]]
 713
 714         return (Just output_fn)
 715
 716 -----------------------------------------------------------------------------
 717 -- As phase
 718
 719 run_phase As _basename _suff input_fn output_fn
 720   = do  as_opts               <- getOpts opt_a
 721         cmdline_include_paths <- readIORef v_Include_paths
 722
 723         SysTools.runAs (map SysTools.Option as_opts
 724                        ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
 725                        ++ [ SysTools.Option "-c"
 726                           , SysTools.FileOption "" input_fn
 727                           , SysTools.Option "-o"
 728                           , SysTools.FileOption "" output_fn
 729                           ])
 730         return (Just output_fn)
 731
 732 run_phase SplitAs basename _suff _input_fn output_fn
 733   = do  as_opts <- getOpts opt_a
 734
 735         (split_s_prefix, n) <- readIORef v_Split_info
 736
 737         odir <- readIORef v_Output_dir
 738         let real_odir = case odir of
 739                                 Nothing -> basename ++ "_split"
 740                                 Just d  -> d
 741
 742         let assemble_file n
 743               = do  let input_s  = split_s_prefix ++ "__" ++ show n ++ ".s"
 744                     let output_o = newdir real_odir
 745                                         (basename ++ "__" ++ show n ++ ".o")
 746                     real_o <- osuf_ify output_o
 747                     SysTools.runAs (map SysTools.Option as_opts ++
 748                                     [ SysTools.Option "-c"
 749                                     , SysTools.Option "-o"
 750                                     , SysTools.FileOption "" real_o
 751                                     , SysTools.FileOption "" input_s
 752                                     ])
 753
 754         mapM_ assemble_file [1..n]
 755         return (Just output_fn)
 756
 757 #ifdef ILX
 758 -----------------------------------------------------------------------------
 759 -- Ilx2Il phase
 760 -- Run ilx2il over the ILX output, getting an IL file
 761
 762 run_phase Ilx2Il _basename _suff input_fn output_fn
 763   = do  ilx2il_opts <- getOpts opt_I
 764         SysTools.runIlx2il (map SysTools.Option ilx2il_opts
 765                            ++ [ SysTools.Option "--no-add-suffix-to-assembly",
 766                                 SysTools.Option "mscorlib",
 767                                 SysTools.Option "-o",
 768                                 SysTools.FileOption "" output_fn,
 769                                 SysTools.FileOption "" input_fn ])
 770         return (Just output_fn)
 771
 772 -----------------------------------------------------------------------------
 773 -- Ilasm phase
 774 -- Run ilasm over the IL, getting a DLL
 775
 776 run_phase Ilasm _basename _suff input_fn output_fn
 777   = do  ilasm_opts <- getOpts opt_i
 778         SysTools.runIlasm (map SysTools.Option ilasm_opts
 779                            ++ [ SysTools.Option "/QUIET",
 780                                 SysTools.Option "/DLL",
 781                                 SysTools.FileOption "/OUT=" output_fn,
 782                                 SysTools.FileOption "" input_fn ])
 783         return (Just output_fn)
 784
 785 #endif -- ILX
 786
 787 -----------------------------------------------------------------------------
 788 -- MoveBinary sort-of-phase
 789 -- After having produced a binary, move it somewhere else and generate a
 790 -- wrapper script calling the binary. Currently, we need this only in
 791 -- a parallel way (i.e. in GUM), because PVM expects the binary in a
 792 -- central directory.
 793 -- This is called from doLink below, after linking. I haven't made it
 794 -- a separate phase to minimise interfering with other modules, and
 795 -- we don't need the generality of a phase (MoveBinary is always
 796 -- done after linking and makes only sense in a parallel setup)   -- HWL
 797
 798 run_phase_MoveBinary input_fn
 799   = do
 800         sysMan   <- getSysMan
 801         pvm_root <- getEnv "PVM_ROOT"
 802         pvm_arch <- getEnv "PVM_ARCH"
 803         let
 804            pvm_executable_base = "=" ++ input_fn
 805            pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
 806         -- nuke old binary; maybe use configur'ed names for cp and rm?
 807         system ("rm -f " ++ pvm_executable)
 808         -- move the newly created binary into PVM land
 809         system ("cp -p " ++ input_fn ++ " " ++ pvm_executable)
 810         -- generate a wrapper script for running a parallel prg under PVM
 811         writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
 812         return True
 813
 814 -- generates a Perl skript starting a parallel prg under PVM
 815 mk_pvm_wrapper_script :: String -> String -> String -> String
 816 mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
 817  [
 818   "eval 'exec perl -S $0 ${1+\"$@\"}'",
 819   "  if $running_under_some_shell;",
 820   "# =!=!=!=!=!=!=!=!=!=!=!",
 821   "# This script is automatically generated: DO NOT EDIT!!!",
 822   "# Generated by Glasgow Haskell Compiler",
 823   "# ngoqvam choHbogh vaj' vIHoHnISbej !!!!",
 824   "#",
 825   "$pvm_executable      = '" ++ pvm_executable ++ "';",
 826   "$pvm_executable_base = '" ++ pvm_executable_base ++ "';",
 827   "$SysMan = '" ++ sysMan ++ "';",
 828   "",
 829   {- ToDo: add the magical shortcuts again iff we actually use them -- HWL
 830   "# first, some magical shortcuts to run "commands" on the binary",
 831   "# (which is hidden)",
 832   "if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {",
 833   "    local($cmd) = $1;",
 834   "    system("$cmd $pvm_executable");",
 835   "    exit(0); # all done",
 836   "}", -}
 837   "",
 838   "# Now, run the real binary; process the args first",
 839   "$ENV{'PE'} = $pvm_executable_base;", --  ++ pvm_executable_base,
 840   "$debug = '';",
 841   "$nprocessors = 0; # the default: as many PEs as machines in PVM config",
 842   "@nonPVM_args = ();",
 843   "$in_RTS_args = 0;",
 844   "",
 845   "args: while ($a = shift(@ARGV)) {",
 846   "    if ( $a eq '+RTS' ) {",
 847   "     $in_RTS_args = 1;",
 848   "    } elsif ( $a eq '-RTS' ) {",
 849   "     $in_RTS_args = 0;",
 850   "    }",
 851   "    if ( $a eq '-d' && $in_RTS_args ) {",
 852   "     $debug = '-';",
 853   "    } elsif ( $a =~ /^-qN(\\d+)/ && $in_RTS_args ) {",
 854   "     $nprocessors = $1;",
 855   "    } elsif ( $a =~ /^-qp(\\d+)/ && $in_RTS_args ) {",
 856   "     $nprocessors = $1;",
 857   "    } else {",
 858   "     push(@nonPVM_args, $a);",
 859   "    }",
 860   "}",
 861   "",
 862   "local($return_val) = 0;",
 863   "# Start the parallel execution by calling SysMan",
 864   "system(\"$SysMan $debug $pvm_executable $nprocessors @nonPVM_args\");",
 865   "$return_val = $?;",
 866   "# ToDo: fix race condition moving files and flushing them!!",
 867   "system(\"cp $ENV{'HOME'}/$pvm_executable_base.???.gr .\") if -f \"$ENV{'HOME'}/$pvm_executable_base.002.gr\";",
 868   "exit($return_val);"
 869  ]
 870
 871 -----------------------------------------------------------------------------
 872 -- Complain about non-dynamic flags in OPTIONS pragmas
 873
 874 checkProcessArgsResult flags basename suff
 875   = do when (notNull flags) (throwDyn (ProgramError (
 876            basename ++ "." ++ suff
 877            ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t"
 878            ++ unwords flags)) (ExitFailure 1))
 879
 880 -----------------------------------------------------------------------------
 881 -- Linking
 882
 883 doLink :: [String] -> IO ()
 884 doLink o_files = do
 885     verb       <- getVerbFlag
 886     static     <- readIORef v_Static
 887     no_hs_main <- readIORef v_NoHsMain
 888
 889     o_file <- readIORef v_Output_file
 890     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 891
 892     pkg_lib_paths <- getPackageLibraryPath
 893     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 894
 895     lib_paths <- readIORef v_Library_paths
 896     let lib_path_opts = map ("-L"++) lib_paths
 897
 898     pkg_libs <- getPackageLibraries
 899     let imp          = if static then "" else "_imp"
 900         pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
 901
 902     libs <- readIORef v_Cmdline_libraries
 903     let lib_opts = map ("-l"++) (reverse libs)
 904          -- reverse because they're added in reverse order from the cmd line
 905
 906 #ifdef darwin_TARGET_OS
 907     pkg_framework_paths <- getPackageFrameworkPath
 908     let pkg_framework_path_opts = map ("-F"++) pkg_framework_paths
 909
 910     framework_paths <- readIORef v_Framework_paths
 911     let framework_path_opts = map ("-F"++) framework_paths
 912
 913     pkg_frameworks <- getPackageFrameworks
 914     let pkg_framework_opts = map ("-framework " ++) pkg_frameworks
 915
 916     frameworks <- readIORef v_Cmdline_frameworks
 917     let framework_opts = map ("-framework "++) (reverse frameworks)
 918          -- reverse because they're added in reverse order from the cmd line
 919 #endif
 920
 921     pkg_extra_ld_opts <- getPackageExtraLdOpts
 922
 923         -- probably _stub.o files
 924     extra_ld_inputs <- readIORef v_Ld_inputs
 925
 926         -- opts from -optl-<blah>
 927     extra_ld_opts <- getStaticOpts v_Opt_l
 928
 929     rts_pkg <- getPackageDetails ["rts"]
 930     std_pkg <- getPackageDetails ["std"]
 931     let extra_os = if static || no_hs_main
 932                    then []
 933                    else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
 934                           head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
 935
 936     (md_c_flags, _) <- machdepCCOpts
 937     SysTools.runLink ( [ SysTools.Option verb
 938                        , SysTools.Option "-o"
 939                        , SysTools.FileOption "" output_fn
 940                        ]
 941                       ++ map SysTools.Option (
 942                          md_c_flags
 943                       ++ o_files
 944                       ++ extra_os
 945                       ++ extra_ld_inputs
 946                       ++ lib_path_opts
 947                       ++ lib_opts
 948 #ifdef darwin_TARGET_OS
 949                       ++ framework_path_opts
 950                       ++ framework_opts
 951 #endif
 952                       ++ pkg_lib_path_opts
 953                       ++ pkg_lib_opts
 954 #ifdef darwin_TARGET_OS
 955                       ++ pkg_framework_path_opts
 956                       ++ pkg_framework_opts
 957 #endif
 958                       ++ pkg_extra_ld_opts
 959                       ++ extra_ld_opts
 960                       ++ if static && not no_hs_main then
 961                             [ "-u", prefixUnderscore "Main_zdmain_closure"]
 962                          else []))
 963
 964     -- parallel only: move binary to another dir -- HWL
 965     ways_ <- readIORef v_Ways
 966     when (WayPar `elem` ways_)
 967          (do success <- run_phase_MoveBinary output_fn
 968              if success then return ()
 969                         else throwDyn (InstallationError ("cannot move binary to PVM dir")))
 970
 971 -----------------------------------------------------------------------------
 972 -- Making a DLL (only for Win32)
 973
 974 doMkDLL :: [String] -> IO ()
 975 doMkDLL o_files = do
 976     verb       <- getVerbFlag
 977     static     <- readIORef v_Static
 978     no_hs_main <- readIORef v_NoHsMain
 979
 980     o_file <- readIORef v_Output_file
 981     let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
 982
 983     pkg_lib_paths <- getPackageLibraryPath
 984     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 985
 986     lib_paths <- readIORef v_Library_paths
 987     let lib_path_opts = map ("-L"++) lib_paths
 988
 989     pkg_libs <- getPackageLibraries
 990     let imp = if static then "" else "_imp"
 991         pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
 992
 993     libs <- readIORef v_Cmdline_libraries
 994     let lib_opts = map ("-l"++) (reverse libs)
 995          -- reverse because they're added in reverse order from the cmd line
 996
 997     pkg_extra_ld_opts <- getPackageExtraLdOpts
 998
 999         -- probably _stub.o files
1000     extra_ld_inputs <- readIORef v_Ld_inputs
1001
1002         -- opts from -optdll-<blah>
1003     extra_ld_opts <- getStaticOpts v_Opt_dll
1004
1005     rts_pkg <- getPackageDetails ["rts"]
1006     std_pkg <- getPackageDetails ["std"]
1007
1008     let extra_os = if static || no_hs_main
1009                    then []
1010                    else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
1011                           head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
1012
1013     (md_c_flags, _) <- machdepCCOpts
1014     SysTools.runMkDLL
1015          ([ SysTools.Option verb
1016           , SysTools.Option "-o"
1017           , SysTools.FileOption "" output_fn
1018           ]
1019          ++ map SysTools.Option (
1020             md_c_flags
1021          ++ o_files
1022          ++ extra_os
1023          ++ [ "--target=i386-mingw32" ]
1024          ++ extra_ld_inputs
1025          ++ lib_path_opts
1026          ++ lib_opts
1027          ++ pkg_lib_path_opts
1028          ++ pkg_lib_opts
1029          ++ pkg_extra_ld_opts
1030          ++ (if "--def" `elem` (concatMap words extra_ld_opts)
1031                then [ "" ]
1032                else [ "--export-all" ])
1033          ++ extra_ld_opts
1034         ))
1035
1036 -----------------------------------------------------------------------------
1037 -- Just preprocess a file, put the result in a temp. file (used by the
1038 -- compilation manager during the summary phase).
1039
1040 preprocess :: FilePath -> IO FilePath
1041 preprocess filename =
1042   ASSERT(haskellish_src_file filename)
1043   do restoreDynFlags    -- Restore to state of last save
1044      let fInfo = (filename, getFileSuffix filename)
1045      pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False
1046                              defaultHscLang fInfo
1047      (fn,_)   <- runPipeline pipeline fInfo
1048                              False{-no linking-} False{-no -o flag-}
1049      return fn
1050
1051 -----------------------------------------------------------------------------
1052 -- Compile a single module, under the control of the compilation manager.
1053 --
1054 -- This is the interface between the compilation manager and the
1055 -- compiler proper (hsc), where we deal with tedious details like
1056 -- reading the OPTIONS pragma from the source file, and passing the
1057 -- output of hsc through the C compiler.
1058
1059 -- The driver sits between 'compile' and 'hscMain', translating calls
1060 -- to the former into calls to the latter, and results from the latter
1061 -- into results from the former.  It does things like preprocessing
1062 -- the .hs file if necessary, and compiling up the .stub_c files to
1063 -- generate Linkables.
1064
1065 -- NB.  No old interface can also mean that the source has changed.
1066
1067 compile :: GhciMode                -- distinguish batch from interactive
1068         -> ModSummary              -- summary, including source
1069         -> Bool                    -- True <=> source unchanged
1070         -> Bool                    -- True <=> have object
1071         -> Maybe ModIface          -- old interface, if available
1072         -> HomeSymbolTable         -- for home module ModDetails
1073         -> HomeIfaceTable          -- for home module Ifaces
1074         -> PersistentCompilerState -- persistent compiler state
1075         -> IO CompResult
1076
1077 data CompResult
1078    = CompOK   PersistentCompilerState   -- updated PCS
1079               ModDetails  -- new details (HST additions)
1080               ModIface    -- new iface   (HIT additions)
1081               (Maybe Linkable)
1082                        -- new code; Nothing => compilation was not reqd
1083                        -- (old code is still valid)
1084
1085    | CompErrs PersistentCompilerState   -- updated PCS
1086
1087
1088 compile ghci_mode summary source_unchanged have_object
1089         old_iface hst hit pcs = do
1090    dyn_flags <- restoreDynFlags         -- Restore to the state of the last save
1091
1092
1093    showPass dyn_flags
1094         (showSDoc (text "Compiling" <+> ppr (modSummaryName summary)))
1095
1096    let verb       = verbosity dyn_flags
1097    let location   = ms_location summary
1098    let input_fn   = expectJust "compile:hs" (ml_hs_file location)
1099    let input_fnpp = expectJust "compile:hspp" (ml_hspp_file location)
1100
1101    when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
1102
1103    opts <- getOptionsFromSource input_fnpp
1104    processArgs dynamic_flags opts []
1105    dyn_flags <- getDynFlags
1106
1107    let hsc_lang      = hscLang dyn_flags
1108        (basename, _) = splitFilename input_fn
1109
1110    keep_hc <- readIORef v_Keep_hc_files
1111 #ifdef ILX
1112    keep_il <- readIORef v_Keep_il_files
1113 #endif
1114    keep_s  <- readIORef v_Keep_s_files
1115
1116    output_fn <-
1117         case hsc_lang of
1118            HscAsm  | keep_s    -> return (basename ++ '.':phaseInputExt As)
1119                    | otherwise -> newTempName (phaseInputExt As)
1120            HscC    | keep_hc   -> return (basename ++ '.':phaseInputExt HCc)
1121                    | otherwise -> newTempName (phaseInputExt HCc)
1122            HscJava             -> newTempName "java" -- ToDo
1123 #ifdef ILX
1124            HscILX  | keep_il   -> return (basename ++ '.':phaseInputExt Ilasm)
1125                    | otherwise -> newTempName (phaseInputExt Ilx2Il)
1126 #endif
1127            HscInterpreted      -> return (error "no output file")
1128            HscNothing          -> return (error "no output file")
1129
1130    let dyn_flags' = dyn_flags { hscOutName = output_fn,
1131                                 hscStubCOutName = basename ++ "_stub.c",
1132                                 hscStubHOutName = basename ++ "_stub.h",
1133                                 extCoreName = basename ++ ".hcr" }
1134
1135    -- figure out which header files to #include in a generated .hc file
1136    c_includes <- getPackageCIncludes
1137    cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
1138
1139    let cc_injects = unlines (map mk_include
1140                                  (c_includes ++ reverse cmdline_includes))
1141        mk_include h_file =
1142         case h_file of
1143            '"':_{-"-} -> "#include "++h_file
1144            '<':_      -> "#include "++h_file
1145            _          -> "#include \""++h_file++"\""
1146
1147    writeIORef v_HCHeader cc_injects
1148
1149    -- -no-recomp should also work with --make
1150    do_recomp <- readIORef v_Recomp
1151    let source_unchanged' = source_unchanged && do_recomp
1152
1153    -- run the compiler
1154    hsc_result <- hscMain ghci_mode dyn_flags'
1155                          (ms_mod summary) location
1156                          source_unchanged' have_object old_iface hst hit pcs
1157
1158    case hsc_result of
1159       HscFail pcs -> return (CompErrs pcs)
1160
1161       HscNoRecomp pcs details iface -> return (CompOK pcs details iface Nothing)
1162
1163       HscRecomp pcs details iface
1164         stub_h_exists stub_c_exists maybe_interpreted_code -> do
1165            let
1166            maybe_stub_o <- compileStub dyn_flags' stub_c_exists
1167            let stub_unlinked = case maybe_stub_o of
1168                                   Nothing -> []
1169                                   Just stub_o -> [ DotO stub_o ]
1170
1171            (hs_unlinked, unlinked_time) <-
1172              case hsc_lang of
1173
1174                 -- in interpreted mode, just return the compiled code
1175                 -- as our "unlinked" object.
1176                 HscInterpreted ->
1177                     case maybe_interpreted_code of
1178 #ifdef GHCI
1179                        Just (bcos,itbl_env) -> do tm <- getClockTime
1180                                                   return ([BCOs bcos itbl_env], tm)
1181 #endif
1182                        Nothing -> panic "compile: no interpreted code"
1183
1184                 -- we're in batch mode: finish the compilation pipeline.
1185                 _other -> do pipe <- genPipeline (StopBefore Ln) "" True
1186                                         hsc_lang (output_fn, getFileSuffix output_fn)
1187                              -- runPipeline takes input_fn so it can split off
1188                              -- the base name and use it as the base of
1189                              -- the output object file.
1190                              let (basename, suffix) = splitFilename input_fn
1191                              (o_file,_) <-
1192                                  pipeLoop pipe (output_fn, getFileSuffix output_fn)
1193                                                False False
1194                                                basename suffix
1195                              o_time <- getModificationTime o_file
1196                              return ([DotO o_file], o_time)
1197
1198            let linkable = LM unlinked_time (modSummaryName summary)
1199                              (hs_unlinked ++ stub_unlinked)
1200
1201            return (CompOK pcs details iface (Just linkable))
1202
1203
1204 -----------------------------------------------------------------------------
1205 -- stub .h and .c files (for foreign export support)
1206
1207 compileStub dflags stub_c_exists
1208   | not stub_c_exists = return Nothing
1209   | stub_c_exists = do
1210         -- compile the _stub.c file w/ gcc
1211         let stub_c = hscStubCOutName dflags
1212         pipeline   <- genPipeline (StopBefore Ln) "" True defaultHscLang (stub_c,"c")
1213         (stub_o,_) <- runPipeline pipeline (stub_c,"c") False{-no linking-}
1214                                   False{-no -o option-}
1215         return (Just stub_o)