ghc/compiler/main/DriverPipeline.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverPipeline.hs,v 1.7 2000/10/26 14:38:42 simonmar Exp $
   3 --
   4 -- GHC Driver
   5 --
   6 -- (c) Simon Marlow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module DriverPipeline (
  11
  12         -- interfaces for the batch-mode driver
  13    GhcMode(..), getGhcMode, v_GhcMode,
  14    genPipeline, runPipeline,
  15
  16         -- interfaces for the compilation manager (interpreted/batch-mode)
  17    preprocess, compile,
  18
  19         -- batch-mode linking interface
  20    doLink,
  21   ) where
  22
  23 #include "HsVersions.h"
  24
  25 import CmSummarise
  26 import CmLink
  27 import DriverState
  28 import DriverUtil
  29 import DriverMkDepend
  30 import DriverPhases
  31 import DriverFlags
  32 import HscMain
  33 import Finder
  34 import TmpFiles
  35 import HscTypes
  36 import Outputable
  37 import Module
  38 import CmdLineOpts
  39 import Config
  40 import Util
  41
  42 import Posix
  43 import Directory
  44 import System
  45 import IOExts
  46 -- import Posix         commented out temp by SLPJ to get going on windows
  47 import Exception
  48
  49 import IO
  50 import Monad
  51 import Maybe
  52
  53 -----------------------------------------------------------------------------
  54 -- GHC modes of operation
  55
  56 data GhcMode
  57   = DoMkDependHS                        -- ghc -M
  58   | DoMkDLL                             -- ghc -mk-dll
  59   | StopBefore Phase                    -- ghc -E | -C | -S | -c
  60   | DoMake                              -- ghc --make
  61   | DoInteractive                       -- ghc --interactive
  62   | DoLink                              -- [ the default ]
  63   deriving (Eq)
  64
  65 GLOBAL_VAR(v_GhcMode, error "todo", GhcMode)
  66
  67 modeFlag :: String -> Maybe GhcMode
  68 modeFlag "-M"            = Just $ DoMkDependHS
  69 modeFlag "-E"            = Just $ StopBefore Hsc
  70 modeFlag "-C"            = Just $ StopBefore HCc
  71 modeFlag "-S"            = Just $ StopBefore As
  72 modeFlag "-c"            = Just $ StopBefore Ln
  73 modeFlag "--make"        = Just $ DoMake
  74 modeFlag "--interactive" = Just $ DoInteractive
  75 modeFlag _               = Nothing
  76
  77 getGhcMode :: [String]
  78          -> IO ( [String]   -- rest of command line
  79                , GhcMode
  80                , String     -- "GhcMode" flag
  81                )
  82 getGhcMode flags
  83   = case my_partition modeFlag flags of
  84         ([]   , rest) -> return (rest, DoLink,  "") -- default is to do linking
  85         ([(flag,one)], rest) -> return (rest, one, flag)
  86         (_    , _   ) ->
  87           throwDyn (OtherError
  88                 "only one of the flags -M, -E, -C, -S, -c, --make, --interactive is allowed")
  89
  90 -----------------------------------------------------------------------------
  91 -- genPipeline
  92 --
  93 -- Herein is all the magic about which phases to run in which order, whether
  94 -- the intermediate files should be in /tmp or in the current directory,
  95 -- what the suffix of the intermediate files should be, etc.
  96
  97 -- The following compilation pipeline algorithm is fairly hacky.  A
  98 -- better way to do this would be to express the whole comilation as a
  99 -- data flow DAG, where the nodes are the intermediate files and the
 100 -- edges are the compilation phases.  This framework would also work
 101 -- nicely if a haskell dependency generator was included in the
 102 -- driver.
 103
 104 -- It would also deal much more cleanly with compilation phases that
 105 -- generate multiple intermediates, (eg. hsc generates .hc, .hi, and
 106 -- possibly stub files), where some of the output files need to be
 107 -- processed further (eg. the stub files need to be compiled by the C
 108 -- compiler).
 109
 110 -- A cool thing to do would then be to execute the data flow graph
 111 -- concurrently, automatically taking advantage of extra processors on
 112 -- the host machine.  For example, when compiling two Haskell files
 113 -- where one depends on the other, the data flow graph would determine
 114 -- that the C compiler from the first comilation can be overlapped
 115 -- with the hsc comilation for the second file.
 116
 117 data IntermediateFileType
 118   = Temporary
 119   | Persistent
 120   deriving (Eq)
 121
 122 genPipeline
 123    :: GhcMode           -- when to stop
 124    -> String            -- "stop after" flag (for error messages)
 125    -> String            -- original filename
 126    -> IO [              -- list of phases to run for this file
 127              (Phase,
 128               IntermediateFileType,  -- keep the output from this phase?
 129               String)                -- output file suffix
 130          ]
 131
 132 genPipeline todo stop_flag filename
 133  = do
 134    split      <- readIORef split_object_files
 135    mangle     <- readIORef do_asm_mangling
 136    lang       <- readIORef hsc_lang
 137    keep_hc    <- readIORef keep_hc_files
 138    keep_raw_s <- readIORef keep_raw_s_files
 139    keep_s     <- readIORef keep_s_files
 140
 141    let
 142    ----------- -----  ----   ---   --   --  -  -  -
 143     (_basename, suffix) = splitFilename filename
 144
 145     start_phase = startPhase suffix
 146
 147     haskellish = haskellish_suffix suffix
 148     cish = cish_suffix suffix
 149
 150    -- for a .hc file, or if the -C flag is given, we need to force lang to HscC
 151     real_lang | suffix == "hc"  = HscC
 152               | otherwise       = lang
 153
 154    let
 155    ----------- -----  ----   ---   --   --  -  -  -
 156     pipeline
 157       | todo == DoMkDependHS = [ Unlit, Cpp, MkDependHS ]
 158
 159       | haskellish =
 160        case real_lang of
 161         HscC    | split && mangle -> [ Unlit, Cpp, Hsc, HCc, Mangle,
 162                                         SplitMangle, SplitAs ]
 163                 | mangle          -> [ Unlit, Cpp, Hsc, HCc, Mangle, As ]
 164                 | split           -> not_valid
 165                 | otherwise       -> [ Unlit, Cpp, Hsc, HCc, As ]
 166
 167         HscAsm  | split           -> [ Unlit, Cpp, Hsc, SplitMangle, SplitAs ]
 168                 | otherwise       -> [ Unlit, Cpp, Hsc, As ]
 169
 170         HscJava | split           -> not_valid
 171                 | otherwise       -> error "not implemented: compiling via Java"
 172
 173       | cish      = [ Cc, As ]
 174
 175       | otherwise = [ ]  -- just pass this file through to the linker
 176
 177         -- ToDo: this is somewhat cryptic
 178     not_valid = throwDyn (OtherError ("invalid option combination"))
 179    ----------- -----  ----   ---   --   --  -  -  -
 180
 181         -- this shouldn't happen.
 182    if start_phase /= Ln && start_phase `notElem` pipeline
 183         then throwDyn (OtherError ("can't find starting phase for "
 184                                     ++ filename))
 185         else do
 186
 187         -- if we can't find the phase we're supposed to stop before,
 188         -- something has gone wrong.
 189    case todo of
 190         StopBefore phase ->
 191            when (phase /= Ln
 192                  && phase `notElem` pipeline
 193                  && not (phase == As && SplitAs `elem` pipeline)) $
 194               throwDyn (OtherError
 195                 ("flag " ++ stop_flag
 196                  ++ " is incompatible with source file `" ++ filename ++ "'"))
 197         _ -> return ()
 198
 199    let
 200    ----------- -----  ----   ---   --   --  -  -  -
 201       annotatePipeline
 202          :: [Phase]             -- raw pipeline
 203          -> Phase               -- phase to stop before
 204          -> [(Phase, IntermediateFileType, String{-file extension-})]
 205       annotatePipeline []     _    = []
 206       annotatePipeline (Ln:_) _    = []
 207       annotatePipeline (phase:next_phase:ps) stop =
 208           (phase, keep_this_output, phaseInputExt next_phase)
 209              : annotatePipeline (next_phase:ps) stop
 210           where
 211                 keep_this_output
 212                      | next_phase == stop = Persistent
 213                      | otherwise =
 214                         case next_phase of
 215                              Ln -> Persistent
 216                              Mangle | keep_raw_s -> Persistent
 217                              As     | keep_s     -> Persistent
 218                              HCc    | keep_hc    -> Persistent
 219                              _other              -> Temporary
 220
 221         -- add information about output files to the pipeline
 222         -- the suffix on an output file is determined by the next phase
 223         -- in the pipeline, so we add linking to the end of the pipeline
 224         -- to force the output from the final phase to be a .o file.
 225       stop_phase = case todo of StopBefore phase -> phase
 226                                 DoMkDependHS     -> Ln
 227                                 DoLink           -> Ln
 228       annotated_pipeline = annotatePipeline (pipeline ++ [ Ln ]) stop_phase
 229
 230       phase_ne p (p1,_,_) = (p1 /= p)
 231    ----------- -----  ----   ---   --   --  -  -  -
 232
 233    return $
 234      dropWhile (phase_ne start_phase) .
 235         foldr (\p ps -> if phase_ne stop_phase p then p:ps else [])  []
 236                 $ annotated_pipeline
 237
 238
 239 runPipeline
 240   :: [ (Phase, IntermediateFileType, String) ] -- phases to run
 241   -> String                     -- input file
 242   -> Bool                       -- doing linking afterward?
 243   -> Bool                       -- take into account -o when generating output?
 244   -> IO String                  -- return final filename
 245
 246 runPipeline pipeline input_fn do_linking use_ofile
 247   = pipeLoop pipeline input_fn do_linking use_ofile basename suffix
 248   where (basename, suffix) = splitFilename input_fn
 249
 250 pipeLoop [] input_fn _ _ _ _ = return input_fn
 251 pipeLoop ((phase, keep, o_suffix):phases)
 252         input_fn do_linking use_ofile orig_basename orig_suffix
 253   = do
 254
 255      output_fn <- outputFileName (null phases) keep o_suffix
 256
 257      carry_on <- run_phase phase orig_basename orig_suffix input_fn output_fn
 258         -- sometimes we bail out early, eg. when the compiler's recompilation
 259         -- checker has determined that recompilation isn't necessary.
 260      if not carry_on
 261         then do let (_,keep,final_suffix) = last phases
 262                 ofile <- outputFileName True keep final_suffix
 263                 return ofile
 264         else do -- carry on ...
 265
 266         -- sadly, ghc -E is supposed to write the file to stdout.  We
 267         -- generate <file>.cpp, so we also have to cat the file here.
 268      when (null phases && phase == Cpp) $
 269         run_something "Dump pre-processed file to stdout"
 270                       ("cat " ++ output_fn)
 271
 272      pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
 273
 274   where
 275      outputFileName last_phase keep suffix
 276         = do o_file <- readIORef output_file
 277              if last_phase && not do_linking && use_ofile && isJust o_file
 278                then case o_file of
 279                        Just s  -> return s
 280                        Nothing -> error "outputFileName"
 281                else if keep == Persistent
 282                            then do f <- odir_ify (orig_basename ++ '.':suffix)
 283                                    osuf_ify f
 284                            else newTempName suffix
 285
 286 -------------------------------------------------------------------------------
 287 -- Unlit phase
 288
 289 run_phase Unlit _basename _suff input_fn output_fn
 290   = do unlit <- readIORef pgm_L
 291        unlit_flags <- getOpts opt_L
 292        run_something "Literate pre-processor"
 293           ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
 294            ++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
 295        return True
 296
 297 -------------------------------------------------------------------------------
 298 -- Cpp phase
 299
 300 run_phase Cpp _basename _suff input_fn output_fn
 301   = do src_opts <- getOptionsFromSource input_fn
 302        _ <- processArgs dynamic_flags src_opts []
 303
 304        do_cpp <- readState cpp_flag
 305        if do_cpp
 306           then do
 307             cpp <- readIORef pgm_P
 308             hscpp_opts <- getOpts opt_P
 309             hs_src_cpp_opts <- readIORef hs_source_cpp_opts
 310
 311             cmdline_include_paths <- readIORef include_paths
 312             pkg_include_dirs <- getPackageIncludePath
 313             let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
 314                                                         ++ pkg_include_dirs)
 315
 316             verb <- is_verbose
 317             run_something "C pre-processor"
 318                 (unwords
 319                    (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
 320                      cpp, verb]
 321                     ++ include_paths
 322                     ++ hs_src_cpp_opts
 323                     ++ hscpp_opts
 324                     ++ [ "-x", "c", input_fn, ">>", output_fn ]
 325                    ))
 326           else do
 327             run_something "Ineffective C pre-processor"
 328                    ("echo '{-# LINE 1 \""  ++ input_fn ++ "\" -}' > "
 329                     ++ output_fn ++ " && cat " ++ input_fn
 330                     ++ " >> " ++ output_fn)
 331        return True
 332
 333 -----------------------------------------------------------------------------
 334 -- MkDependHS phase
 335
 336 run_phase MkDependHS basename suff input_fn _output_fn = do
 337    src <- readFile input_fn
 338    let imports = getImports src
 339
 340    deps <- mapM (findDependency basename) imports
 341
 342    osuf_opt <- readIORef output_suf
 343    let osuf = case osuf_opt of
 344                         Nothing -> "o"
 345                         Just s  -> s
 346
 347    extra_suffixes <- readIORef dep_suffixes
 348    let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
 349        ofiles = map (\suf -> basename ++ '.':suf) suffixes
 350
 351    objs <- mapM odir_ify ofiles
 352
 353    hdl <- readIORef dep_tmp_hdl
 354
 355         -- std dependeny of the object(s) on the source file
 356    hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
 357
 358    let genDep (dep, False {- not an hi file -}) =
 359           hPutStrLn hdl (unwords objs ++ " : " ++ dep)
 360        genDep (dep, True  {- is an hi file -}) = do
 361           hisuf <- readIORef hi_suf
 362           let dep_base = remove_suffix '.' dep
 363               deps = (dep_base ++ hisuf)
 364                      : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
 365                   -- length objs should be == length deps
 366           sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps)
 367
 368    mapM genDep [ d | Just d <- deps ]
 369
 370    return True
 371
 372 -- add the lines to dep_makefile:
 373            -- always:
 374                    -- this.o : this.hs
 375
 376            -- if the dependency is on something other than a .hi file:
 377                    -- this.o this.p_o ... : dep
 378            -- otherwise
 379                    -- if the import is {-# SOURCE #-}
 380                            -- this.o this.p_o ... : dep.hi-boot[-$vers]
 381
 382                    -- else
 383                            -- this.o ...   : dep.hi
 384                            -- this.p_o ... : dep.p_hi
 385                            -- ...
 386
 387            -- (where .o is $osuf, and the other suffixes come from
 388            -- the cmdline -s options).
 389
 390 -----------------------------------------------------------------------------
 391 -- Hsc phase
 392
 393 run_phase Hsc basename suff input_fn output_fn
 394   = do
 395
 396   -- we add the current directory (i.e. the directory in which
 397   -- the .hs files resides) to the import path, since this is
 398   -- what gcc does, and it's probably what you want.
 399         let current_dir = getdir basename
 400
 401         paths <- readIORef include_paths
 402         writeIORef include_paths (current_dir : paths)
 403
 404   -- figure out where to put the .hi file
 405         ohi    <- readIORef output_hi
 406         hisuf  <- readIORef hi_suf
 407         let hifile = case ohi of
 408                            Nothing -> current_dir ++ {-ToDo: modname!!-}basename
 409                                         ++ hisuf
 410                            Just fn -> fn
 411
 412   -- figure out if the source has changed, for recompilation avoidance.
 413   -- only do this if we're eventually going to generate a .o file.
 414   -- (ToDo: do when generating .hc files too?)
 415   --
 416   -- Setting source_unchanged to "-fsource_unchanged" means that M.o seems
 417   -- to be up to date wrt M.hs; so no need to recompile unless imports have
 418   -- changed (which the compiler itself figures out).
 419   -- Setting source_unchanged to "" tells the compiler that M.o is out of
 420   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
 421         do_recomp <- readIORef recomp
 422         todo <- readIORef v_GhcMode
 423         o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
 424         source_unchanged <-
 425           if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
 426              then return ""
 427              else do t1 <- getModificationTime (basename ++ '.':suff)
 428                      o_file_exists <- doesFileExist o_file
 429                      if not o_file_exists
 430                         then return ""  -- Need to recompile
 431                         else do t2 <- getModificationTime o_file
 432                                 if t2 > t1
 433                                   then return "-fsource-unchanged"
 434                                   else return ""
 435
 436    -- build a bogus ModSummary to pass to hscMain.
 437         let summary = ModSummary {
 438                         ms_location = error "no loc",
 439                         ms_ppsource = Just (input_fn, error "no fingerprint"),
 440                         ms_imports = error "no imports"
 441                      }
 442
 443   -- get the DynFlags
 444         dyn_flags <- readIORef v_DynFlags
 445
 446   -- run the compiler!
 447         pcs <- initPersistentCompilerState
 448         result <- hscMain dyn_flags{ hscOutName = output_fn }
 449                           (error "no Finder!")
 450                           summary
 451                           Nothing        -- no iface
 452                           emptyModuleEnv -- HomeSymbolTable
 453                           emptyModuleEnv -- HomeIfaceTable
 454                           emptyModuleEnv -- PackageIfaceTable
 455                           pcs
 456
 457         case result of {
 458
 459             HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
 460
 461             HscOK details maybe_iface maybe_stub_h maybe_stub_c
 462                         _maybe_interpreted_code pcs -> do
 463
 464    -- generate the interface file
 465         case maybe_iface of
 466            Nothing -> -- compilation not required
 467              do run_something "Touching object file" ("touch " ++ o_file)
 468                 return False
 469
 470            Just iface -> do
 471                 -- discover the filename for the .hi file in a roundabout way
 472                 let mod = moduleString (mi_module iface)
 473                 ohi    <- readIORef output_hi
 474                 hifile <- case ohi of
 475                             Just fn -> fn
 476                             Nothing -> do hisuf  <- readIORef hi_suf
 477                                           return (current_dir ++
 478                                                         '/'mod ++ '.':hisuf)
 479                 -- write out the interface...
 480                 if_hdl <- openFile hifile WriteMode
 481                 printForIface if_hdl (pprIface iface)
 482                 hClose if_hdl
 483
 484     -- deal with stubs
 485         maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
 486         case maybe_stub_o of
 487                 Nothing -> return ()
 488                 Just stub_o -> add ld_inputs stub_o
 489
 490         return True
 491     }
 492
 493 -----------------------------------------------------------------------------
 494 -- Cc phase
 495
 496 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 497 -- way too many hacks, and I can't say I've ever used it anyway.
 498
 499 run_phase cc_phase _basename _suff input_fn output_fn
 500    | cc_phase == Cc || cc_phase == HCc
 501    = do cc <- readIORef pgm_c
 502         cc_opts <- (getOpts opt_c)
 503         cmdline_include_dirs <- readIORef include_paths
 504
 505         let hcc = cc_phase == HCc
 506
 507                 -- add package include paths even if we're just compiling
 508                 -- .c files; this is the Value Add(TM) that using
 509                 -- ghc instead of gcc gives you :)
 510         pkg_include_dirs <- getPackageIncludePath
 511         let include_paths = map (\p -> "-I"++p) (cmdline_include_dirs
 512                                                         ++ pkg_include_dirs)
 513
 514         c_includes <- getPackageCIncludes
 515         cmdline_includes <- readState cmdline_hc_includes -- -#include options
 516
 517         let cc_injects | hcc = unlines (map mk_include
 518                                         (c_includes ++ reverse cmdline_includes))
 519                        | otherwise = ""
 520             mk_include h_file =
 521                 case h_file of
 522                    '"':_{-"-} -> "#include "++h_file
 523                    '<':_      -> "#include "++h_file
 524                    _          -> "#include \""++h_file++"\""
 525
 526         cc_help <- newTempName "c"
 527         h <- openFile cc_help WriteMode
 528         hPutStr h cc_injects
 529         hPutStrLn h ("#include \"" ++ input_fn ++ "\"\n")
 530         hClose h
 531
 532         ccout <- newTempName "ccout"
 533
 534         mangle <- readIORef do_asm_mangling
 535         (md_c_flags, md_regd_c_flags) <- machdepCCOpts
 536
 537         verb <- is_verbose
 538
 539         o2 <- readIORef v_minus_o2_for_C
 540         let opt_flag | o2        = "-O2"
 541                      | otherwise = "-O"
 542
 543         pkg_extra_cc_opts <- getPackageExtraCcOpts
 544
 545         excessPrecision <- readIORef excess_precision
 546
 547         run_something "C Compiler"
 548          (unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
 549                    ++ md_c_flags
 550                    ++ (if cc_phase == HCc && mangle
 551                          then md_regd_c_flags
 552                          else [])
 553                    ++ [ verb, "-S", "-Wimplicit", opt_flag ]
 554                    ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 555                    ++ cc_opts
 556 #ifdef mingw32_TARGET_OS
 557                    ++ [" -mno-cygwin"]
 558 #endif
 559                    ++ (if excessPrecision then [] else [ "-ffloat-store" ])
 560                    ++ include_paths
 561                    ++ pkg_extra_cc_opts
 562 --                 ++ [">", ccout]
 563                    ))
 564         return True
 565
 566         -- ToDo: postprocess the output from gcc
 567
 568 -----------------------------------------------------------------------------
 569 -- Mangle phase
 570
 571 run_phase Mangle _basename _suff input_fn output_fn
 572   = do mangler <- readIORef pgm_m
 573        mangler_opts <- getOpts opt_m
 574        machdep_opts <-
 575          if (prefixMatch "i386" cTARGETPLATFORM)
 576             then do n_regs <- readState stolen_x86_regs
 577                     return [ show n_regs ]
 578             else return []
 579        run_something "Assembly Mangler"
 580         (unwords (mangler :
 581                      mangler_opts
 582                   ++ [ input_fn, output_fn ]
 583                   ++ machdep_opts
 584                 ))
 585        return True
 586
 587 -----------------------------------------------------------------------------
 588 -- Splitting phase
 589
 590 run_phase SplitMangle _basename _suff input_fn _output_fn
 591   = do  splitter <- readIORef pgm_s
 592
 593         -- this is the prefix used for the split .s files
 594         tmp_pfx <- readIORef v_TmpDir
 595         x <- getProcessID
 596         let split_s_prefix = tmp_pfx ++ "/ghc" ++ show x
 597         writeIORef split_prefix split_s_prefix
 598         addFilesToClean [split_s_prefix ++ "__*"] -- d:-)
 599
 600         -- allocate a tmp file to put the no. of split .s files in (sigh)
 601         n_files <- newTempName "n_files"
 602
 603         run_something "Split Assembly File"
 604          (unwords [ splitter
 605                   , input_fn
 606                   , split_s_prefix
 607                   , n_files ]
 608          )
 609
 610         -- save the number of split files for future references
 611         s <- readFile n_files
 612         let n = read s :: Int
 613         writeIORef n_split_files n
 614         return True
 615
 616 -----------------------------------------------------------------------------
 617 -- As phase
 618
 619 run_phase As _basename _suff input_fn output_fn
 620   = do  as <- readIORef pgm_a
 621         as_opts <- getOpts opt_a
 622
 623         cmdline_include_paths <- readIORef include_paths
 624         let cmdline_include_flags = map (\p -> "-I"++p) cmdline_include_paths
 625         run_something "Assembler"
 626            (unwords (as : as_opts
 627                        ++ cmdline_include_flags
 628                        ++ [ "-c", input_fn, "-o",  output_fn ]
 629                     ))
 630         return True
 631
 632 run_phase SplitAs basename _suff _input_fn _output_fn
 633   = do  as <- readIORef pgm_a
 634         as_opts <- getOpts opt_a
 635
 636         split_s_prefix <- readIORef split_prefix
 637         n <- readIORef n_split_files
 638
 639         odir <- readIORef output_dir
 640         let real_odir = case odir of
 641                                 Nothing -> basename
 642                                 Just d  -> d
 643
 644         let assemble_file n = do
 645                     let input_s  = split_s_prefix ++ "__" ++ show n ++ ".s"
 646                     let output_o = newdir real_odir
 647                                         (basename ++ "__" ++ show n ++ ".o")
 648                     real_o <- osuf_ify output_o
 649                     run_something "Assembler"
 650                             (unwords (as : as_opts
 651                                       ++ [ "-c", "-o", real_o, input_s ]
 652                             ))
 653
 654         mapM_ assemble_file [1..n]
 655         return True
 656
 657 -----------------------------------------------------------------------------
 658 -- Linking
 659
 660 doLink :: [String] -> IO ()
 661 doLink o_files = do
 662     ln <- readIORef pgm_l
 663     verb <- is_verbose
 664     o_file <- readIORef output_file
 665     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 666
 667     pkg_lib_paths <- getPackageLibraryPath
 668     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 669
 670     lib_paths <- readIORef library_paths
 671     let lib_path_opts = map ("-L"++) lib_paths
 672
 673     pkg_libs <- getPackageLibraries
 674     let pkg_lib_opts = map (\lib -> "-l"++lib) pkg_libs
 675
 676     libs <- readIORef cmdline_libraries
 677     let lib_opts = map ("-l"++) (reverse libs)
 678          -- reverse because they're added in reverse order from the cmd line
 679
 680     pkg_extra_ld_opts <- getPackageExtraLdOpts
 681
 682         -- probably _stub.o files
 683     extra_ld_inputs <- readIORef ld_inputs
 684
 685         -- opts from -optl-<blah>
 686     extra_ld_opts <- getStaticOpts opt_l
 687
 688     run_something "Linker"
 689        (unwords
 690          ([ ln, verb, "-o", output_fn ]
 691          ++ o_files
 692          ++ extra_ld_inputs
 693          ++ lib_path_opts
 694          ++ lib_opts
 695          ++ pkg_lib_path_opts
 696          ++ pkg_lib_opts
 697          ++ pkg_extra_ld_opts
 698          ++ extra_ld_opts
 699         )
 700        )
 701
 702 -----------------------------------------------------------------------------
 703 -- Just preprocess a file, put the result in a temp. file (used by the
 704 -- compilation manager during the summary phase).
 705
 706 preprocess :: FilePath -> IO FilePath
 707 preprocess filename =
 708   ASSERT(haskellish_file filename)
 709   do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") filename
 710      runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
 711
 712 -----------------------------------------------------------------------------
 713 -- Compile a single module.
 714 --
 715 -- This is the interface between the compilation manager and the
 716 -- compiler proper (hsc), where we deal with tedious details like
 717 -- reading the OPTIONS pragma from the source file, and passing the
 718 -- output of hsc through the C compiler.
 719
 720 -- The driver sits between 'compile' and 'hscMain', translating calls
 721 -- to the former into calls to the latter, and results from the latter
 722 -- into results from the former.  It does things like preprocessing
 723 -- the .hs file if necessary, and compiling up the .stub_c files to
 724 -- generate Linkables.
 725
 726 compile :: Finder                  -- to find modules
 727         -> ModSummary              -- summary, including source
 728         -> Maybe ModIface          -- old interface, if available
 729         -> HomeSymbolTable         -- for home module ModDetails
 730         -> PersistentCompilerState -- persistent compiler state
 731         -> IO CompResult
 732
 733 data CompResult
 734    = CompOK   ModDetails  -- new details (HST additions)
 735               (Maybe (ModIface, Linkable))
 736                        -- summary and code; Nothing => compilation not reqd
 737                        -- (old summary and code are still valid)
 738               PersistentCompilerState   -- updated PCS
 739
 740    | CompErrs PersistentCompilerState   -- updated PCS
 741
 742
 743 compile finder summary old_iface hst pcs = do
 744    verb <- readIORef verbose
 745    when verb (hPutStrLn stderr ("compile: compiling " ++
 746                                 name_of_summary summary))
 747
 748    init_dyn_flags <- readIORef v_InitDynFlags
 749    writeIORef v_DynFlags init_dyn_flags
 750
 751    let input_fn = case ms_ppsource summary of
 752                         Just (ppsource, fingerprint) -> ppsource
 753                         Nothing -> hs_file (ms_location summary)
 754
 755    when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
 756
 757    opts <- getOptionsFromSource input_fn
 758    processArgs dynamic_flags opts []
 759    dyn_flags <- readIORef v_DynFlags
 760
 761    output_fn <- case hsc_lang of
 762                     HscAsm         -> newTempName (phaseInputExt As)
 763                     HscC           -> newTempName (phaseInputExt HCc)
 764                     HscJava        -> newTempName "java" -- ToDo
 765                     HscInterpreted -> return (error "no output file")
 766
 767    -- run the compiler
 768    hsc_result <- hscMain dyn_flags summary old_iface output_fn hst pcs
 769
 770    case hsc_result of {
 771       HscFail pcs -> return (CompErrs pcs);
 772
 773       HscOK details maybe_iface
 774         maybe_stub_h maybe_stub_c maybe_interpreted_code pcs warns -> do
 775
 776            -- if no compilation happened, bail out early
 777            case maybe_iface of {
 778                 Nothing -> return (CompOK details Nothing pcs warns);
 779                 Just iface -> do
 780
 781            let (basename, _) = splitFilename (hs_file (ms_location summary))
 782            maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
 783            stub_unlinked <- case maybe_stub_o of
 784                                 Nothing -> []
 785                                 Just stub_o -> [ DotO stub_o ]
 786
 787            hs_unlinked <-
 788              case hsc_lang of
 789
 790                 -- in interpreted mode, just return the compiled code
 791                 -- as our "unlinked" object.
 792                 HscInterpreted ->
 793                     case maybe_interpreted_code of
 794                         Just code -> return (Trees code)
 795                         Nothing   -> panic "compile: no interpreted code"
 796
 797                 -- we're in batch mode: finish the compilation pipeline.
 798                 _other -> do pipe <- genPipeline (StopBefore Ln) "" output_fn
 799                              o_file <- runPipeline pipe output_fn False False
 800                              return [ DotO o_file ]
 801
 802            let linkable = LM (moduleName (ms_mod summary))
 803                                 (hs_unlinked ++ stub_unlinked)
 804
 805            return (CompOK details (Just (iface, linkable)) pcs warns)
 806           }
 807    }
 808
 809 -----------------------------------------------------------------------------
 810 -- stub .h and .c files (for foreign export support)
 811
 812 dealWithStubs basename maybe_stub_h maybe_stub_c
 813
 814  = do   let stub_h = basename ++ "_stub.h"
 815         let stub_c = basename ++ "_stub.c"
 816
 817   -- copy the .stub_h file into the current dir if necessary
 818         case maybe_stub_h of
 819            Nothing -> return ()
 820            Just tmp_stub_h -> do
 821                 run_something "Copy stub .h file"
 822                                 ("cp " ++ tmp_stub_h ++ ' ':stub_h)
 823
 824                         -- #include <..._stub.h> in .hc file
 825                 addCmdlineHCInclude tmp_stub_h  -- hack
 826
 827   -- copy the .stub_c file into the current dir, and compile it, if necessary
 828         case maybe_stub_c of
 829            Nothing -> return Nothing
 830            Just tmp_stub_c -> do  -- copy the _stub.c file into the current dir
 831                 run_something "Copy stub .c file"
 832                     (unwords [
 833                         "rm -f", stub_c, "&&",
 834                         "echo \'#include \""++stub_h++"\"\' >"++stub_c, " &&",
 835                         "cat", tmp_stub_c, ">> ", stub_c
 836                         ])
 837
 838                         -- compile the _stub.c file w/ gcc
 839                 pipeline <- genPipeline (StopBefore Ln) "" stub_c
 840                 stub_o <- runPipeline pipeline stub_c False{-no linking-}
 841                                 False{-no -o option-}
 842
 843                 return (Just stub_o)