+data CompResult
+ = CompOK ModDetails -- New details
+ ModIface -- New iface
+ (Maybe Linkable) -- a Maybe, for the same reasons as hm_linkable
+
+ | CompErrs
+
+
+compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
+
+ let dflags0 = ms_hspp_opts mod_summary
+ this_mod = ms_mod mod_summary
+ src_flavour = ms_hsc_src mod_summary
+
+ have_object
+ | Just l <- maybe_old_linkable, isObjectLinkable l = True
+ | otherwise = False
+
+ showPass dflags0 ("Compiling " ++ showModMsg have_object mod_summary)
+
+ let location = ms_location mod_summary
+ let input_fn = expectJust "compile:hs" (ml_hs_file location)
+ let input_fnpp = ms_hspp_file mod_summary
+
+ debugTraceMsg dflags0 2 (text "compile: input file" <+> text input_fnpp)
+
+ let (basename, _) = splitFilename input_fn
+
+ -- We add the directory in which the .hs files resides) to the import path.
+ -- This is needed when we try to compile the .hc file later, if it
+ -- imports a _stub.h file that we created here.
+ let current_dir = directoryOf basename
+ old_paths = includePaths dflags0
+ dflags = dflags0 { includePaths = current_dir : old_paths }
+
+ -- Figure out what lang we're generating
+ let hsc_lang = hscMaybeAdjustTarget dflags StopLn src_flavour (hscTarget dflags)
+ -- ... and what the next phase should be
+ let next_phase = hscNextPhase dflags src_flavour hsc_lang
+ -- ... and what file to generate the output into
+ output_fn <- getOutputFilename dflags next_phase
+ Temporary basename next_phase (Just location)
+
+ let dflags' = dflags { hscTarget = hsc_lang,
+ hscOutName = output_fn,
+ extCoreName = basename ++ ".hcr" }
+
+ -- -no-recomp should also work with --make
+ let do_recomp = dopt Opt_RecompChecking dflags
+ source_unchanged = isJust maybe_old_linkable && do_recomp
+ hsc_env' = hsc_env { hsc_dflags = dflags' }
+ object_filename = ml_obj_file location
+
+ let getStubLinkable False = return []
+ getStubLinkable True
+ = do stub_o <- compileStub dflags' this_mod location
+ return [ DotO stub_o ]
+
+ handleBatch (HscNoRecomp, iface, details)
+ = ASSERT (isJust maybe_old_linkable)
+ return (CompOK details iface maybe_old_linkable)
+ handleBatch (HscRecomp hasStub, iface, details)
+ | isHsBoot src_flavour
+ = return (CompOK details iface Nothing)
+ | otherwise
+ = do stub_unlinked <- getStubLinkable hasStub
+ (hs_unlinked, unlinked_time) <-
+ case hsc_lang of
+ HscNothing
+ -> return ([], ms_hs_date mod_summary)
+ -- We're in --make mode: finish the compilation pipeline.
+ _other
+ -> do runPipeline StopLn dflags (output_fn,Nothing) Persistent
+ (Just location)
+ -- The object filename comes from the ModLocation
+ o_time <- getModificationTime object_filename
+ return ([DotO object_filename], o_time)
+ let linkable = LM unlinked_time this_mod
+ (hs_unlinked ++ stub_unlinked)
+ return (CompOK details iface (Just linkable))
+
+ handleInterpreted (InteractiveNoRecomp, iface, details)
+ = ASSERT (isJust maybe_old_linkable)
+ return (CompOK details iface maybe_old_linkable)
+ handleInterpreted (InteractiveRecomp hasStub comp_bc, iface, details)
+ = do stub_unlinked <- getStubLinkable hasStub
+ let hs_unlinked = [BCOs comp_bc]
+ unlinked_time = ms_hs_date mod_summary
+ -- Why do we use the timestamp of the source file here,
+ -- rather than the current time? This works better in
+ -- the case where the local clock is out of sync
+ -- with the filesystem's clock. It's just as accurate:
+ -- if the source is modified, then the linkable will
+ -- be out of date.
+ let linkable = LM unlinked_time this_mod
+ (hs_unlinked ++ stub_unlinked)
+ return (CompOK details iface (Just linkable))
+
+ let runCompiler compiler handle
+ = do mbResult <- compiler hsc_env' mod_summary
+ source_unchanged old_iface
+ (Just (mod_index, nmods))
+ case mbResult of
+ Nothing -> return CompErrs
+ Just result -> handle result
+ -- run the compiler
+ case hsc_lang of
+ HscInterpreted | not (isHsBoot src_flavour) -- We can't compile boot files to
+ -- bytecode so don't even try.
+ -> runCompiler hscCompileInteractive handleInterpreted
+ HscNothing
+ -> runCompiler hscCompileNothing handleBatch
+ _other
+ -> runCompiler hscCompileBatch handleBatch
+
+-----------------------------------------------------------------------------
+-- stub .h and .c files (for foreign export support)
+
+-- The _stub.c file is derived from the haskell source file, possibly taking
+-- into account the -stubdir option.
+--
+-- Consequently, we derive the _stub.o filename from the haskell object
+-- filename.
+--
+-- This isn't necessarily the same as the object filename we
+-- would get if we just compiled the _stub.c file using the pipeline.
+-- For example:
+--
+-- ghc src/A.hs -odir obj
+--
+-- results in obj/A.o, and src/A_stub.c. If we compile src/A_stub.c with
+-- -odir obj, we would get obj/src/A_stub.o, which is wrong; we want
+-- obj/A_stub.o.
+
+compileStub :: DynFlags -> Module -> ModLocation -> IO FilePath
+compileStub dflags mod location = do
+ let (o_base, o_ext) = splitFilename (ml_obj_file location)
+ stub_o = o_base ++ "_stub" `joinFileExt` o_ext
+
+ -- compile the _stub.c file w/ gcc
+ let (stub_c,_) = mkStubPaths dflags mod location
+ runPipeline StopLn dflags (stub_c,Nothing)
+ (SpecificFile stub_o) Nothing{-no ModLocation-}
+
+ return stub_o
+
+
+-- ---------------------------------------------------------------------------
+-- Link
+
+link :: GhcMode -- interactive or batch
+ -> DynFlags -- dynamic flags
+ -> Bool -- attempt linking in batch mode?
+ -> HomePackageTable -- what to link
+ -> IO SuccessFlag
+
+-- For the moment, in the batch linker, we don't bother to tell doLink
+-- which packages to link -- it just tries all that are available.
+-- batch_attempt_linking should only be *looked at* in batch mode. It
+-- should only be True if the upsweep was successful and someone
+-- exports main, i.e., we have good reason to believe that linking
+-- will succeed.
+
+#ifdef GHCI
+link Interactive dflags batch_attempt_linking hpt
+ = do -- Not Linking...(demand linker will do the job)
+ return Succeeded