ghc/compiler/main/DriverPipeline.hs

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