1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow, 2005
7 -- -----------------------------------------------------------------------------
12 defaultCleanupHandler,
15 Ghc, GhcT, GhcMonad(..),
16 runGhc, runGhcT, initGhcMonad,
17 gcatch, gbracket, gfinally,
19 printExceptionAndWarnings,
23 -- * Flags and settings
24 DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
25 GhcMode(..), GhcLink(..), defaultObjectTarget,
32 Target(..), TargetId(..), Phase,
39 -- * Loading\/compiling the program
41 load, LoadHowMuch(..),
42 SuccessFlag(..), succeeded, failed,
43 defaultWarnErrLogger, WarnErrLogger,
44 workingDirectoryChanged,
45 parseModule, typecheckModule, desugarModule, loadModule,
46 ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),
47 TypecheckedSource, ParsedSource, RenamedSource, -- ditto
48 TypecheckedMod, ParsedMod,
49 moduleInfo, renamedSource, typecheckedSource,
50 parsedSource, coreModule,
51 compileToCoreModule, compileToCoreSimplified,
55 -- * Inspecting the module structure of the program
56 ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
61 -- * Inspecting modules
68 modInfoIsExportedName,
72 mkPrintUnqualifiedForModule,
74 -- * Querying the environment
78 PrintUnqualified, alwaysQualify,
80 -- * Interactive evaluation
81 getBindings, getPrintUnqual,
85 setContext, getContext,
95 runStmt, parseImportDecl, SingleStep(..),
97 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
98 resumeHistory, resumeHistoryIx),
99 History(historyBreakInfo, historyEnclosingDecls),
100 GHC.getHistorySpan, getHistoryModule,
103 InteractiveEval.back,
104 InteractiveEval.forward,
107 InteractiveEval.compileExpr, HValue, dynCompileExpr,
108 GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
110 ModBreaks(..), BreakIndex,
111 BreakInfo(breakInfo_number, breakInfo_module),
112 BreakArray, setBreakOn, setBreakOff, getBreak,
116 -- * Abstract syntax elements
122 Module, mkModule, pprModule, moduleName, modulePackageId,
123 ModuleName, mkModuleName, moduleNameString,
127 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
129 RdrName(Qual,Unqual),
133 isImplicitId, isDeadBinder,
134 isExportedId, isLocalId, isGlobalId,
136 isPrimOpId, isFCallId, isClassOpId_maybe,
137 isDataConWorkId, idDataCon,
138 isBottomingId, isDictonaryId,
139 recordSelectorFieldLabel,
141 -- ** Type constructors
143 tyConTyVars, tyConDataCons, tyConArity,
144 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
146 synTyConDefn, synTyConType, synTyConResKind,
152 -- ** Data constructors
154 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
155 dataConIsInfix, isVanillaDataCon, dataConUserType,
157 StrictnessMark(..), isMarkedStrict,
161 classMethods, classSCTheta, classTvsFds,
166 instanceDFunId, pprInstance, pprInstanceHdr,
168 -- ** Types and Kinds
169 Type, splitForAllTys, funResultTy,
170 pprParendType, pprTypeApp,
173 ThetaType, pprForAll, pprThetaArrow,
179 module HsSyn, -- ToDo: remove extraneous bits
183 defaultFixity, maxPrecedence,
187 -- ** Source locations
189 mkSrcLoc, isGoodSrcLoc, noSrcLoc,
190 srcLocFile, srcLocLine, srcLocCol,
192 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
193 srcSpanStart, srcSpanEnd,
195 srcSpanStartLine, srcSpanEndLine,
196 srcSpanStartCol, srcSpanEndCol,
201 -- *** Constructing Located
202 noLoc, mkGeneralLocated,
204 -- *** Deconstructing Located
207 -- *** Combining and comparing Located values
208 eqLocated, cmpLocated, combineLocs, addCLoc,
209 leftmost_smallest, leftmost_largest, rightmost,
213 GhcException(..), showGhcException,
215 -- * Token stream manipulations
217 getTokenStream, getRichTokenStream,
218 showRichTokenStream, addSourceToTokens,
220 -- * Pure interface to the parser
231 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
232 * what StaticFlags should we expose, if any?
235 #include "HsVersions.h"
238 import qualified Linker
239 import Linker ( HValue )
242 import InteractiveEval
248 import TcRnMonad ( initIfaceCheck )
252 import qualified HsSyn -- hack as we want to reexport the whole module
253 import HsSyn hiding ((<.>))
255 import Coercion ( synTyConResKind )
256 import TcType hiding( typeKind )
259 import TysPrim ( alphaTyVars )
264 import Name hiding ( varName )
265 -- import OccName ( parenSymOcc )
268 import CoreSyn ( CoreBind )
270 import DriverPipeline
271 import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
277 import StaticFlagParser
278 import qualified StaticFlags
279 import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
286 import Bag ( unitBag, listToBag )
293 import Maybes ( expectJust, mapCatMaybes )
295 import qualified Parser
298 import System.Directory ( getModificationTime, doesFileExist,
299 getCurrentDirectory )
301 import Data.Map (Map)
302 import qualified Data.Map as Map
303 import qualified FiniteMap as Map
305 import qualified Data.List as List
306 import Data.Typeable ( Typeable )
307 import Data.Word ( Word8 )
309 import System.Exit ( exitWith, ExitCode(..) )
310 import System.Time ( ClockTime, getClockTime )
313 import System.FilePath
315 import System.IO.Error ( isDoesNotExistError )
316 import Prelude hiding (init)
319 -- -----------------------------------------------------------------------------
320 -- Exception handlers
322 -- | Install some default exception handlers and run the inner computation.
323 -- Unless you want to handle exceptions yourself, you should wrap this around
324 -- the top level of your program. The default handlers output the error
325 -- message(s) to stderr and exit cleanly.
326 defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
327 defaultErrorHandler dflags inner =
328 -- top-level exception handler: any unrecognised exception is a compiler bug.
329 ghandle (\exception -> liftIO $ do
331 case fromException exception of
332 -- an IO exception probably isn't our fault, so don't panic
333 Just (ioe :: IOException) ->
334 fatalErrorMsg dflags (text (show ioe))
335 _ -> case fromException exception of
336 Just UserInterrupt -> exitWith (ExitFailure 1)
337 Just StackOverflow ->
338 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
339 _ -> case fromException exception of
340 Just (ex :: ExitCode) -> throw ex
343 (text (show (Panic (show exception))))
344 exitWith (ExitFailure 1)
347 -- error messages propagated as exceptions
352 PhaseFailed _ code -> exitWith code
353 Signal _ -> exitWith (ExitFailure 1)
354 _ -> do fatalErrorMsg dflags (text (show ge))
355 exitWith (ExitFailure 1)
359 -- | Install a default cleanup handler to remove temporary files deposited by
360 -- a GHC run. This is seperate from 'defaultErrorHandler', because you might
361 -- want to override the error handling, but still get the ordinary cleanup
363 defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
364 DynFlags -> m a -> m a
365 defaultCleanupHandler dflags inner =
366 -- make sure we clean up after ourselves
369 cleanTempFiles dflags
372 -- exceptions will be blocked while we clean the temporary files,
373 -- so there shouldn't be any difficulty if we receive further
376 -- | Print the error message and all warnings. Useful inside exception
377 -- handlers. Clears warnings after printing.
378 printException :: GhcMonad m => SourceError -> m ()
379 printException err = do
380 dflags <- getSessionDynFlags
381 liftIO $ printBagOfErrors dflags (srcErrorMessages err)
383 {-# DEPRECATED printExceptionAndWarnings "use printException instead" #-}
384 printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
385 printExceptionAndWarnings = printException
387 -- | Run function for the 'Ghc' monad.
389 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
390 -- to this function will create a new session which should not be shared among
393 -- Any errors not handled inside the 'Ghc' action are propagated as IO
396 runGhc :: Maybe FilePath -- ^ See argument to 'initGhcMonad'.
397 -> Ghc a -- ^ The action to perform.
399 runGhc mb_top_dir ghc = do
400 ref <- newIORef undefined
401 let session = Session ref
402 flip unGhc session $ do
403 initGhcMonad mb_top_dir
405 -- XXX: unregister interrupt handlers here?
407 -- | Run function for 'GhcT' monad transformer.
409 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
410 -- to this function will create a new session which should not be shared among
413 runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
414 Maybe FilePath -- ^ See argument to 'initGhcMonad'.
415 -> GhcT m a -- ^ The action to perform.
417 runGhcT mb_top_dir ghct = do
418 ref <- liftIO $ newIORef undefined
419 let session = Session ref
420 flip unGhcT session $ do
421 initGhcMonad mb_top_dir
424 -- | Initialise a GHC session.
426 -- If you implement a custom 'GhcMonad' you must call this function in the
427 -- monad run function. It will initialise the session variable and clear all
430 -- The first argument should point to the directory where GHC's library files
431 -- reside. More precisely, this should be the output of @ghc --print-libdir@
432 -- of the version of GHC the module using this API is compiled with. For
433 -- portability, you should use the @ghc-paths@ package, available at
434 -- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
436 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
437 initGhcMonad mb_top_dir = do
439 liftIO $ installSignalHandlers
441 liftIO $ StaticFlags.initStaticOpts
443 dflags0 <- liftIO $ initDynFlags defaultDynFlags
444 dflags <- liftIO $ initSysTools mb_top_dir dflags0
445 env <- liftIO $ newHscEnv dflags
448 -- -----------------------------------------------------------------------------
451 -- | Updates the DynFlags in a Session. This also reads
452 -- the package database (unless it has already been read),
453 -- and prepares the compilers knowledge about packages. It
454 -- can be called again to load new packages: just add new
455 -- package flags to (packageFlags dflags).
457 -- Returns a list of new packages that may need to be linked in using
458 -- the dynamic linker (see 'linkPackages') as a result of new package
459 -- flags. If you are not doing linking or doing static linking, you
460 -- can ignore the list of packages returned.
462 setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
463 setSessionDynFlags dflags = do
464 (dflags', preload) <- liftIO $ initPackages dflags
465 modifySession (\h -> h{ hsc_dflags = dflags' })
468 -- | If there is no -o option, guess the name of target executable
469 -- by using top-level source file name as a base.
470 guessOutputFile :: GhcMonad m => m ()
471 guessOutputFile = modifySession $ \env ->
472 let dflags = hsc_dflags env
473 mod_graph = hsc_mod_graph env
474 mainModuleSrcPath :: Maybe String
475 mainModuleSrcPath = do
476 let isMain = (== mainModIs dflags) . ms_mod
477 [ms] <- return (filter isMain mod_graph)
478 ml_hs_file (ms_location ms)
479 name = fmap dropExtension mainModuleSrcPath
481 #if defined(mingw32_HOST_OS)
482 -- we must add the .exe extention unconditionally here, otherwise
483 -- when name has an extension of its own, the .exe extension will
484 -- not be added by DriverPipeline.exeFileName. See #2248
485 name_exe = fmap (<.> "exe") name
490 case outputFile dflags of
492 Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
494 -- -----------------------------------------------------------------------------
497 -- ToDo: think about relative vs. absolute file paths. And what
498 -- happens when the current directory changes.
500 -- | Sets the targets for this session. Each target may be a module name
501 -- or a filename. The targets correspond to the set of root modules for
502 -- the program\/library. Unloading the current program is achieved by
503 -- setting the current set of targets to be empty, followed by 'load'.
504 setTargets :: GhcMonad m => [Target] -> m ()
505 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
507 -- | Returns the current set of targets
508 getTargets :: GhcMonad m => m [Target]
509 getTargets = withSession (return . hsc_targets)
511 -- | Add another target.
512 addTarget :: GhcMonad m => Target -> m ()
514 = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
517 removeTarget :: GhcMonad m => TargetId -> m ()
518 removeTarget target_id
519 = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
521 filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
523 -- | Attempts to guess what Target a string refers to. This function
524 -- implements the @--make@/GHCi command-line syntax for filenames:
526 -- - if the string looks like a Haskell source filename, then interpret it
529 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
532 -- - otherwise interpret the string as a module name
534 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
535 guessTarget str (Just phase)
536 = return (Target (TargetFile str (Just phase)) True Nothing)
537 guessTarget str Nothing
538 | isHaskellSrcFilename file
539 = return (target (TargetFile file Nothing))
541 = do exists <- liftIO $ doesFileExist hs_file
543 then return (target (TargetFile hs_file Nothing))
545 exists <- liftIO $ doesFileExist lhs_file
547 then return (target (TargetFile lhs_file Nothing))
549 if looksLikeModuleName file
550 then return (target (TargetModule (mkModuleName file)))
553 (ProgramError (showSDoc $
554 text "target" <+> quotes (text file) <+>
555 text "is not a module name or a source file"))
558 | '*':rest <- str = (rest, False)
559 | otherwise = (str, True)
561 hs_file = file <.> "hs"
562 lhs_file = file <.> "lhs"
564 target tid = Target tid obj_allowed Nothing
566 -- -----------------------------------------------------------------------------
567 -- Loading the program
569 -- | Perform a dependency analysis starting from the current targets
570 -- and update the session with the new module graph.
572 -- Dependency analysis entails parsing the @import@ directives and may
573 -- therefore require running certain preprocessors.
575 -- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
576 -- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
577 -- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want to
578 -- changes to the 'DynFlags' to take effect you need to call this function
581 depanal :: GhcMonad m =>
582 [ModuleName] -- ^ excluded modules
583 -> Bool -- ^ allow duplicate roots
585 depanal excluded_mods allow_dup_roots = do
586 hsc_env <- getSession
588 dflags = hsc_dflags hsc_env
589 targets = hsc_targets hsc_env
590 old_graph = hsc_mod_graph hsc_env
592 liftIO $ showPass dflags "Chasing dependencies"
593 liftIO $ debugTraceMsg dflags 2 (hcat [
594 text "Chasing modules from: ",
595 hcat (punctuate comma (map pprTarget targets))])
597 mod_graph <- liftIO $ downsweep hsc_env old_graph excluded_mods allow_dup_roots
598 modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
601 -- | Describes which modules of the module graph need to be loaded.
604 -- ^ Load all targets and its dependencies.
605 | LoadUpTo ModuleName
606 -- ^ Load only the given module and its dependencies.
607 | LoadDependenciesOf ModuleName
608 -- ^ Load only the dependencies of the given module, but not the module
611 -- | Try to load the program. See 'LoadHowMuch' for the different modes.
613 -- This function implements the core of GHC's @--make@ mode. It preprocesses,
614 -- compiles and loads the specified modules, avoiding re-compilation wherever
615 -- possible. Depending on the target (see 'DynFlags.hscTarget') compilating
616 -- and loading may result in files being created on disk.
618 -- Calls the 'reportModuleCompilationResult' callback after each compiling
619 -- each module, whether successful or not.
621 -- Throw a 'SourceError' if errors are encountered before the actual
622 -- compilation starts (e.g., during dependency analysis). All other errors
623 -- are reported using the callback.
625 load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
627 mod_graph <- depanal [] False
628 load2 how_much mod_graph
630 -- | A function called to log warnings and errors.
631 type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
633 defaultWarnErrLogger :: WarnErrLogger
634 defaultWarnErrLogger Nothing = return ()
635 defaultWarnErrLogger (Just e) = printException e
637 load2 :: GhcMonad m => LoadHowMuch -> [ModSummary]
639 load2 how_much mod_graph = do
641 hsc_env <- getSession
643 let hpt1 = hsc_HPT hsc_env
644 let dflags = hsc_dflags hsc_env
646 -- The "bad" boot modules are the ones for which we have
647 -- B.hs-boot in the module graph, but no B.hs
648 -- The downsweep should have ensured this does not happen
650 let all_home_mods = [ms_mod_name s
651 | s <- mod_graph, not (isBootSummary s)]
652 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
653 not (ms_mod_name s `elem` all_home_mods)]
654 ASSERT( null bad_boot_mods ) return ()
656 -- check that the module given in HowMuch actually exists, otherwise
657 -- topSortModuleGraph will bomb later.
658 let checkHowMuch (LoadUpTo m) = checkMod m
659 checkHowMuch (LoadDependenciesOf m) = checkMod m
663 | m `elem` all_home_mods = and_then
665 liftIO $ errorMsg dflags (text "no such module:" <+>
669 checkHowMuch how_much $ do
671 -- mg2_with_srcimps drops the hi-boot nodes, returning a
672 -- graph with cycles. Among other things, it is used for
673 -- backing out partially complete cycles following a failed
674 -- upsweep, and for removing from hpt all the modules
675 -- not in strict downwards closure, during calls to compile.
676 let mg2_with_srcimps :: [SCC ModSummary]
677 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
679 -- If we can determine that any of the {-# SOURCE #-} imports
680 -- are definitely unnecessary, then emit a warning.
681 warnUnnecessarySourceImports mg2_with_srcimps
684 -- check the stability property for each module.
685 stable_mods@(stable_obj,stable_bco)
686 = checkStability hpt1 mg2_with_srcimps all_home_mods
688 -- prune bits of the HPT which are definitely redundant now,
690 pruned_hpt = pruneHomePackageTable hpt1
691 (flattenSCCs mg2_with_srcimps)
694 _ <- liftIO $ evaluate pruned_hpt
696 -- before we unload anything, make sure we don't leave an old
697 -- interactive context around pointing to dead bindings. Also,
698 -- write the pruned HPT to allow the old HPT to be GC'd.
699 modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext,
700 hsc_HPT = pruned_hpt }
702 liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
703 text "Stable BCO:" <+> ppr stable_bco)
705 -- Unload any modules which are going to be re-linked this time around.
706 let stable_linkables = [ linkable
707 | m <- stable_obj++stable_bco,
708 Just hmi <- [lookupUFM pruned_hpt m],
709 Just linkable <- [hm_linkable hmi] ]
710 liftIO $ unload hsc_env stable_linkables
712 -- We could at this point detect cycles which aren't broken by
713 -- a source-import, and complain immediately, but it seems better
714 -- to let upsweep_mods do this, so at least some useful work gets
715 -- done before the upsweep is abandoned.
716 --hPutStrLn stderr "after tsort:\n"
717 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
719 -- Now do the upsweep, calling compile for each module in
720 -- turn. Final result is version 3 of everything.
722 -- Topologically sort the module graph, this time including hi-boot
723 -- nodes, and possibly just including the portion of the graph
724 -- reachable from the module specified in the 2nd argument to load.
725 -- This graph should be cycle-free.
726 -- If we're restricting the upsweep to a portion of the graph, we
727 -- also want to retain everything that is still stable.
728 let full_mg :: [SCC ModSummary]
729 full_mg = topSortModuleGraph False mod_graph Nothing
731 maybe_top_mod = case how_much of
733 LoadDependenciesOf m -> Just m
736 partial_mg0 :: [SCC ModSummary]
737 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
739 -- LoadDependenciesOf m: we want the upsweep to stop just
740 -- short of the specified module (unless the specified module
743 | LoadDependenciesOf _mod <- how_much
744 = ASSERT( case last partial_mg0 of
745 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
746 List.init partial_mg0
752 | AcyclicSCC ms <- full_mg,
753 ms_mod_name ms `elem` stable_obj++stable_bco,
754 ms_mod_name ms `notElem` [ ms_mod_name ms' |
755 AcyclicSCC ms' <- partial_mg ] ]
757 mg = stable_mg ++ partial_mg
759 -- clean up between compilations
760 let cleanup = cleanTempFilesExcept dflags
761 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
763 liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
766 setSession hsc_env{ hsc_HPT = emptyHomePackageTable }
767 (upsweep_ok, modsUpswept)
768 <- upsweep pruned_hpt stable_mods cleanup mg
770 -- Make modsDone be the summaries for each home module now
771 -- available; this should equal the domain of hpt3.
772 -- Get in in a roughly top .. bottom order (hence reverse).
774 let modsDone = reverse modsUpswept
776 -- Try and do linking in some form, depending on whether the
777 -- upsweep was completely or only partially successful.
779 if succeeded upsweep_ok
782 -- Easy; just relink it all.
783 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
785 -- Clean up after ourselves
786 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
788 -- Issue a warning for the confusing case where the user
789 -- said '-o foo' but we're not going to do any linking.
790 -- We attempt linking if either (a) one of the modules is
791 -- called Main, or (b) the user said -no-hs-main, indicating
792 -- that main() is going to come from somewhere else.
794 let ofile = outputFile dflags
795 let no_hs_main = dopt Opt_NoHsMain dflags
797 main_mod = mainModIs dflags
798 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
799 do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib
801 when (ghcLink dflags == LinkBinary
802 && isJust ofile && not do_linking) $
803 liftIO $ debugTraceMsg dflags 1 $
804 text ("Warning: output was redirected with -o, " ++
805 "but no output will be generated\n" ++
806 "because there is no " ++
807 moduleNameString (moduleName main_mod) ++ " module.")
809 -- link everything together
810 hsc_env1 <- getSession
811 linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
813 loadFinish Succeeded linkresult
816 -- Tricky. We need to back out the effects of compiling any
817 -- half-done cycles, both so as to clean up the top level envs
818 -- and to avoid telling the interactive linker to link them.
819 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep partially successful.")
822 = map ms_mod modsDone
823 let mods_to_zap_names
824 = findPartiallyCompletedCycles modsDone_names
827 = filter ((`notElem` mods_to_zap_names).ms_mod)
830 hsc_env1 <- getSession
831 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
834 -- Clean up after ourselves
835 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
837 -- there should be no Nothings where linkables should be, now
838 ASSERT(all (isJust.hm_linkable)
839 (eltsUFM (hsc_HPT hsc_env))) do
841 -- Link everything together
842 linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4
844 modifySession $ \hsc_env -> hsc_env{ hsc_HPT = hpt4 }
845 loadFinish Failed linkresult
847 -- Finish up after a load.
849 -- If the link failed, unload everything and return.
850 loadFinish :: GhcMonad m =>
851 SuccessFlag -> SuccessFlag
853 loadFinish _all_ok Failed
854 = do hsc_env <- getSession
855 liftIO $ unload hsc_env []
856 modifySession discardProg
859 -- Empty the interactive context and set the module context to the topmost
860 -- newly loaded module, or the Prelude if none were loaded.
861 loadFinish all_ok Succeeded
862 = do modifySession $ \hsc_env -> hsc_env{ hsc_IC = emptyInteractiveContext }
866 -- Forget the current program, but retain the persistent info in HscEnv
867 discardProg :: HscEnv -> HscEnv
869 = hsc_env { hsc_mod_graph = emptyMG,
870 hsc_IC = emptyInteractiveContext,
871 hsc_HPT = emptyHomePackageTable }
873 -- used to fish out the preprocess output files for the purposes of
874 -- cleaning up. The preprocessed file *might* be the same as the
875 -- source file, but that doesn't do any harm.
876 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
877 ppFilesFromSummaries summaries = map ms_hspp_file summaries
879 -- -----------------------------------------------------------------------------
881 class ParsedMod m where
882 modSummary :: m -> ModSummary
883 parsedSource :: m -> ParsedSource
885 class ParsedMod m => TypecheckedMod m where
886 renamedSource :: m -> Maybe RenamedSource
887 typecheckedSource :: m -> TypecheckedSource
888 moduleInfo :: m -> ModuleInfo
889 tm_internals :: m -> (TcGblEnv, ModDetails)
890 -- ToDo: improvements that could be made here:
891 -- if the module succeeded renaming but not typechecking,
892 -- we can still get back the GlobalRdrEnv and exports, so
893 -- perhaps the ModuleInfo should be split up into separate
896 class TypecheckedMod m => DesugaredMod m where
897 coreModule :: m -> ModGuts
899 -- | The result of successful parsing.
901 ParsedModule { pm_mod_summary :: ModSummary
902 , pm_parsed_source :: ParsedSource }
904 instance ParsedMod ParsedModule where
905 modSummary m = pm_mod_summary m
906 parsedSource m = pm_parsed_source m
908 -- | The result of successful typechecking. It also contains the parser
910 data TypecheckedModule =
911 TypecheckedModule { tm_parsed_module :: ParsedModule
912 , tm_renamed_source :: Maybe RenamedSource
913 , tm_typechecked_source :: TypecheckedSource
914 , tm_checked_module_info :: ModuleInfo
915 , tm_internals_ :: (TcGblEnv, ModDetails)
918 instance ParsedMod TypecheckedModule where
919 modSummary m = modSummary (tm_parsed_module m)
920 parsedSource m = parsedSource (tm_parsed_module m)
922 instance TypecheckedMod TypecheckedModule where
923 renamedSource m = tm_renamed_source m
924 typecheckedSource m = tm_typechecked_source m
925 moduleInfo m = tm_checked_module_info m
926 tm_internals m = tm_internals_ m
928 -- | The result of successful desugaring (i.e., translation to core). Also
929 -- contains all the information of a typechecked module.
930 data DesugaredModule =
931 DesugaredModule { dm_typechecked_module :: TypecheckedModule
932 , dm_core_module :: ModGuts
935 instance ParsedMod DesugaredModule where
936 modSummary m = modSummary (dm_typechecked_module m)
937 parsedSource m = parsedSource (dm_typechecked_module m)
939 instance TypecheckedMod DesugaredModule where
940 renamedSource m = renamedSource (dm_typechecked_module m)
941 typecheckedSource m = typecheckedSource (dm_typechecked_module m)
942 moduleInfo m = moduleInfo (dm_typechecked_module m)
943 tm_internals m = tm_internals_ (dm_typechecked_module m)
945 instance DesugaredMod DesugaredModule where
946 coreModule m = dm_core_module m
948 type ParsedSource = Located (HsModule RdrName)
949 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
951 type TypecheckedSource = LHsBinds Id
954 -- - things that aren't in the output of the typechecker right now:
958 -- - type/data/newtype declarations
959 -- - class declarations
961 -- - extra things in the typechecker's output:
962 -- - default methods are turned into top-level decls.
963 -- - dictionary bindings
965 -- | Return the 'ModSummary' of a module with the given name.
967 -- The module must be part of the module graph (see 'hsc_mod_graph' and
968 -- 'ModuleGraph'). If this is not the case, this function will throw a
971 -- This function ignores boot modules and requires that there is only one
972 -- non-boot module with the given name.
973 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
974 getModSummary mod = do
975 mg <- liftM hsc_mod_graph getSession
976 case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
977 [] -> throw $ mkApiErr (text "Module not part of module graph")
979 multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
983 -- Throws a 'SourceError' on parse error.
984 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
986 hsc_env <- getSession
987 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
988 rdr_module <- liftIO $ hscParse hsc_env_tmp ms
989 return (ParsedModule ms rdr_module)
991 -- | Typecheck and rename a parsed module.
993 -- Throws a 'SourceError' if either fails.
994 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
995 typecheckModule pmod = do
996 let ms = modSummary pmod
997 hsc_env <- getSession
998 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
999 (tc_gbl_env, rn_info)
1000 <- liftIO $ hscTypecheckRename hsc_env_tmp ms (parsedSource pmod)
1001 details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
1004 tm_internals_ = (tc_gbl_env, details),
1005 tm_parsed_module = pmod,
1006 tm_renamed_source = rn_info,
1007 tm_typechecked_source = tcg_binds tc_gbl_env,
1008 tm_checked_module_info =
1010 minf_type_env = md_types details,
1011 minf_exports = availsToNameSet $ md_exports details,
1012 minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
1013 minf_instances = md_insts details
1015 ,minf_modBreaks = emptyModBreaks
1019 -- | Desugar a typechecked module.
1020 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
1021 desugarModule tcm = do
1022 let ms = modSummary tcm
1023 let (tcg, _) = tm_internals tcm
1024 hsc_env <- getSession
1025 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
1026 guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg
1029 dm_typechecked_module = tcm,
1030 dm_core_module = guts
1033 -- | Load a module. Input doesn't need to be desugared.
1035 -- A module must be loaded before dependent modules can be typechecked. This
1036 -- always includes generating a 'ModIface' and, depending on the
1037 -- 'DynFlags.hscTarget', may also include code generation.
1039 -- This function will always cause recompilation and will always overwrite
1040 -- previous compilation results (potentially files on disk).
1042 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
1044 let ms = modSummary tcm
1045 let mod = ms_mod_name ms
1046 let loc = ms_location ms
1047 let (tcg, _details) = tm_internals tcm
1049 mb_linkable <- case ms_obj_date ms of
1050 Just t | t > ms_hs_date ms -> do
1051 l <- liftIO $ findObjectLinkable (ms_mod ms)
1054 _otherwise -> return Nothing
1056 -- compile doesn't change the session
1057 hsc_env <- getSession
1058 mod_info <- liftIO $ compile' (hscNothingBackendOnly tcg,
1059 hscInteractiveBackendOnly tcg,
1060 hscBatchBackendOnly tcg)
1061 hsc_env ms 1 1 Nothing mb_linkable
1063 modifySession $ \e -> e{ hsc_HPT = addToUFM (hsc_HPT e) mod mod_info }
1066 -- -----------------------------------------------------------------------------
1067 -- Operations dealing with Core
1069 -- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
1070 -- the 'GHC.compileToCoreModule' interface.
1074 cm_module :: !Module,
1075 -- | Type environment for types declared in this module
1076 cm_types :: !TypeEnv,
1078 cm_binds :: [CoreBind],
1080 cm_imports :: ![Module]
1083 instance Outputable CoreModule where
1084 ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb}) =
1085 text "%module" <+> ppr mn <+> ppr te $$ vcat (map ppr cb)
1087 -- | This is the way to get access to the Core bindings corresponding
1088 -- to a module. 'compileToCore' parses, typechecks, and
1089 -- desugars the module, then returns the resulting Core module (consisting of
1090 -- the module name, type declarations, and function declarations) if
1092 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
1093 compileToCoreModule = compileCore False
1095 -- | Like compileToCoreModule, but invokes the simplifier, so
1096 -- as to return simplified and tidied Core.
1097 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
1098 compileToCoreSimplified = compileCore True
1100 -- | Provided for backwards-compatibility: compileToCore returns just the Core
1101 -- bindings, but for most purposes, you probably want to call
1102 -- compileToCoreModule.
1103 compileToCore :: GhcMonad m => FilePath -> m [CoreBind]
1104 compileToCore fn = do
1105 mod <- compileToCoreModule session fn
1106 return $ cm_binds mod
1108 -- | Takes a CoreModule and compiles the bindings therein
1109 -- to object code. The first argument is a bool flag indicating
1110 -- whether to run the simplifier.
1111 -- The resulting .o, .hi, and executable files, if any, are stored in the
1112 -- current directory, and named according to the module name.
1113 -- This has only so far been tested with a single self-contained module.
1114 compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
1115 compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
1116 dflags <- getSessionDynFlags
1117 currentTime <- liftIO $ getClockTime
1118 cwd <- liftIO $ getCurrentDirectory
1119 modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
1120 ((moduleNameSlashes . moduleName) mName)
1122 let modSummary = ModSummary { ms_mod = mName,
1123 ms_hsc_src = ExtCoreFile,
1124 ms_location = modLocation,
1125 -- By setting the object file timestamp to Nothing,
1126 -- we always force recompilation, which is what we
1127 -- want. (Thus it doesn't matter what the timestamp
1128 -- for the (nonexistent) source file is.)
1129 ms_hs_date = currentTime,
1130 ms_obj_date = Nothing,
1131 -- Only handling the single-module case for now, so no imports.
1136 ms_hspp_opts = dflags,
1137 ms_hspp_buf = Nothing
1140 hsc_env <- getSession
1141 liftIO $ hscCompileCore hsc_env simplify modSummary (cm_binds cm)
1144 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
1145 compileCore simplify fn = do
1146 -- First, set the target to the desired filename
1147 target <- guessTarget fn Nothing
1149 _ <- load LoadAllTargets
1150 -- Then find dependencies
1151 modGraph <- depanal [] True
1152 case find ((== fn) . msHsFilePath) modGraph of
1153 Just modSummary -> do
1154 -- Now we have the module name;
1155 -- parse, typecheck and desugar the module
1156 mod_guts <- coreModule `fmap`
1157 -- TODO: space leaky: call hsc* directly?
1158 (desugarModule =<< typecheckModule =<< parseModule modSummary)
1159 liftM gutsToCoreModule $
1162 -- If simplify is true: simplify (hscSimplify), then tidy
1164 hsc_env <- getSession
1165 simpl_guts <- liftIO $ hscSimplify hsc_env mod_guts
1166 tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
1167 return $ Left tidy_guts
1169 return $ Right mod_guts
1171 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1172 module dependency graph"
1173 where -- two versions, based on whether we simplify (thus run tidyProgram,
1174 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1175 -- we just have a ModGuts.
1176 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
1177 gutsToCoreModule (Left (cg, md)) = CoreModule {
1178 cm_module = cg_module cg, cm_types = md_types md,
1179 cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
1181 gutsToCoreModule (Right mg) = CoreModule {
1182 cm_module = mg_module mg, cm_types = mg_types mg,
1183 cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds = mg_binds mg
1186 -- ---------------------------------------------------------------------------
1189 unload :: HscEnv -> [Linkable] -> IO ()
1190 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
1191 = case ghcLink (hsc_dflags hsc_env) of
1193 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
1195 LinkInMemory -> panic "unload: no interpreter"
1196 -- urgh. avoid warnings:
1197 hsc_env stable_linkables
1201 -- -----------------------------------------------------------------------------
1205 Stability tells us which modules definitely do not need to be recompiled.
1206 There are two main reasons for having stability:
1208 - avoid doing a complete upsweep of the module graph in GHCi when
1209 modules near the bottom of the tree have not changed.
1211 - to tell GHCi when it can load object code: we can only load object code
1212 for a module when we also load object code fo all of the imports of the
1213 module. So we need to know that we will definitely not be recompiling
1214 any of these modules, and we can use the object code.
1216 The stability check is as follows. Both stableObject and
1217 stableBCO are used during the upsweep phase later.
1220 stable m = stableObject m || stableBCO m
1223 all stableObject (imports m)
1224 && old linkable does not exist, or is == on-disk .o
1225 && date(on-disk .o) > date(.hs)
1228 all stable (imports m)
1229 && date(BCO) > date(.hs)
1232 These properties embody the following ideas:
1234 - if a module is stable, then:
1236 - if it has been compiled in a previous pass (present in HPT)
1237 then it does not need to be compiled or re-linked.
1239 - if it has not been compiled in a previous pass,
1240 then we only need to read its .hi file from disk and
1241 link it to produce a 'ModDetails'.
1243 - if a modules is not stable, we will definitely be at least
1244 re-linking, and possibly re-compiling it during the 'upsweep'.
1245 All non-stable modules can (and should) therefore be unlinked
1246 before the 'upsweep'.
1248 - Note that objects are only considered stable if they only depend
1249 on other objects. We can't link object code against byte code.
1253 :: HomePackageTable -- HPT from last compilation
1254 -> [SCC ModSummary] -- current module graph (cyclic)
1255 -> [ModuleName] -- all home modules
1256 -> ([ModuleName], -- stableObject
1257 [ModuleName]) -- stableBCO
1259 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1261 checkSCC (stable_obj, stable_bco) scc0
1262 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1263 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
1264 | otherwise = (stable_obj, stable_bco)
1266 scc = flattenSCC scc0
1267 scc_mods = map ms_mod_name scc
1268 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
1270 scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
1271 -- all imports outside the current SCC, but in the home pkg
1273 stable_obj_imps = map (`elem` stable_obj) scc_allimps
1274 stable_bco_imps = map (`elem` stable_bco) scc_allimps
1278 && all object_ok scc
1281 and (zipWith (||) stable_obj_imps stable_bco_imps)
1285 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
1289 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1290 Just hmi | Just l <- hm_linkable hmi
1291 -> isObjectLinkable l && t == linkableTime l
1293 -- why '>=' rather than '>' above? If the filesystem stores
1294 -- times to the nearset second, we may occasionally find that
1295 -- the object & source have the same modification time,
1296 -- especially if the source was automatically generated
1297 -- and compiled. Using >= is slightly unsafe, but it matches
1298 -- make's behaviour.
1301 = case lookupUFM hpt (ms_mod_name ms) of
1302 Just hmi | Just l <- hm_linkable hmi ->
1303 not (isObjectLinkable l) &&
1304 linkableTime l >= ms_hs_date ms
1307 -- -----------------------------------------------------------------------------
1309 -- | Prune the HomePackageTable
1311 -- Before doing an upsweep, we can throw away:
1313 -- - For non-stable modules:
1314 -- - all ModDetails, all linked code
1315 -- - all unlinked code that is out of date with respect to
1318 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1319 -- space at the end of the upsweep, because the topmost ModDetails of the
1320 -- old HPT holds on to the entire type environment from the previous
1323 pruneHomePackageTable
1326 -> ([ModuleName],[ModuleName])
1329 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1332 | is_stable modl = hmi'
1333 | otherwise = hmi'{ hm_details = emptyModDetails }
1335 modl = moduleName (mi_module (hm_iface hmi))
1336 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1337 = hmi{ hm_linkable = Nothing }
1340 where ms = expectJust "prune" (lookupUFM ms_map modl)
1342 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1344 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1346 -- -----------------------------------------------------------------------------
1348 -- Return (names of) all those in modsDone who are part of a cycle
1349 -- as defined by theGraph.
1350 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1351 findPartiallyCompletedCycles modsDone theGraph
1355 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
1356 chew ((CyclicSCC vs):rest)
1357 = let names_in_this_cycle = nub (map ms_mod vs)
1359 = nub ([done | done <- modsDone,
1360 done `elem` names_in_this_cycle])
1361 chewed_rest = chew rest
1363 if notNull mods_in_this_cycle
1364 && length mods_in_this_cycle < length names_in_this_cycle
1365 then mods_in_this_cycle ++ chewed_rest
1368 -- -----------------------------------------------------------------------------
1372 -- This is where we compile each module in the module graph, in a pass
1373 -- from the bottom to the top of the graph.
1375 -- There better had not be any cyclic groups here -- we check for them.
1379 => HomePackageTable -- ^ HPT from last time round (pruned)
1380 -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
1381 -> IO () -- ^ How to clean up unwanted tmp files
1382 -> [SCC ModSummary] -- ^ Mods to do (the worklist)
1387 -- 1. A flag whether the complete upsweep was successful.
1388 -- 2. The 'HscEnv' in the monad has an updated HPT
1389 -- 3. A list of modules which succeeded loading.
1391 upsweep old_hpt stable_mods cleanup sccs = do
1392 (res, done) <- upsweep' old_hpt [] sccs 1 (length sccs)
1393 return (res, reverse done)
1396 upsweep' _old_hpt done
1398 = return (Succeeded, done)
1400 upsweep' _old_hpt done
1401 (CyclicSCC ms:_) _ _
1402 = do dflags <- getSessionDynFlags
1403 liftIO $ fatalErrorMsg dflags (cyclicModuleErr ms)
1404 return (Failed, done)
1406 upsweep' old_hpt done
1407 (AcyclicSCC mod:mods) mod_index nmods
1408 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1409 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1410 -- (moduleEnvElts (hsc_HPT hsc_env)))
1411 let logger _mod = defaultWarnErrLogger
1413 hsc_env <- getSession
1415 <- handleSourceError
1416 (\err -> do logger mod (Just err); return Nothing) $ do
1417 mod_info <- liftIO $ upsweep_mod hsc_env old_hpt stable_mods
1419 logger mod Nothing -- log warnings
1420 return (Just mod_info)
1422 liftIO cleanup -- Remove unwanted tmp files between compilations
1425 Nothing -> return (Failed, done)
1427 let this_mod = ms_mod_name mod
1429 -- Add new info to hsc_env
1430 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1431 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1433 -- Space-saving: delete the old HPT entry
1434 -- for mod BUT if mod is a hs-boot
1435 -- node, don't delete it. For the
1436 -- interface, the HPT entry is probaby for the
1437 -- main Haskell source file. Deleting it
1438 -- would force the real module to be recompiled
1440 old_hpt1 | isBootSummary mod = old_hpt
1441 | otherwise = delFromUFM old_hpt this_mod
1445 -- fixup our HomePackageTable after we've finished compiling
1446 -- a mutually-recursive loop. See reTypecheckLoop, below.
1447 hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done'
1450 upsweep' old_hpt1 done' mods (mod_index+1) nmods
1452 -- | Compile a single module. Always produce a Linkable for it if
1453 -- successful. If no compilation happened, return the old Linkable.
1454 upsweep_mod :: HscEnv
1456 -> ([ModuleName],[ModuleName])
1458 -> Int -- index of module
1459 -> Int -- total number of modules
1462 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1464 this_mod_name = ms_mod_name summary
1465 this_mod = ms_mod summary
1466 mb_obj_date = ms_obj_date summary
1467 obj_fn = ml_obj_file (ms_location summary)
1468 hs_date = ms_hs_date summary
1470 is_stable_obj = this_mod_name `elem` stable_obj
1471 is_stable_bco = this_mod_name `elem` stable_bco
1473 old_hmi = lookupUFM old_hpt this_mod_name
1475 -- We're using the dflags for this module now, obtained by
1476 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1477 dflags = ms_hspp_opts summary
1478 prevailing_target = hscTarget (hsc_dflags hsc_env)
1479 local_target = hscTarget dflags
1481 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1482 -- we don't do anything dodgy: these should only work to change
1483 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1484 -- end up trying to link object code to byte code.
1485 target = if prevailing_target /= local_target
1486 && (not (isObjectTarget prevailing_target)
1487 || not (isObjectTarget local_target))
1488 then prevailing_target
1491 -- store the corrected hscTarget into the summary
1492 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1494 -- The old interface is ok if
1495 -- a) we're compiling a source file, and the old HPT
1496 -- entry is for a source file
1497 -- b) we're compiling a hs-boot file
1498 -- Case (b) allows an hs-boot file to get the interface of its
1499 -- real source file on the second iteration of the compilation
1500 -- manager, but that does no harm. Otherwise the hs-boot file
1501 -- will always be recompiled
1506 Just hm_info | isBootSummary summary -> Just iface
1507 | not (mi_boot iface) -> Just iface
1508 | otherwise -> Nothing
1510 iface = hm_iface hm_info
1512 compile_it :: Maybe Linkable -> IO HomeModInfo
1513 compile_it mb_linkable =
1514 compile hsc_env summary' mod_index nmods
1515 mb_old_iface mb_linkable
1517 compile_it_discard_iface :: Maybe Linkable -> IO HomeModInfo
1518 compile_it_discard_iface mb_linkable =
1519 compile hsc_env summary' mod_index nmods
1522 -- With the HscNothing target we create empty linkables to avoid
1523 -- recompilation. We have to detect these to recompile anyway if
1524 -- the target changed since the last compile.
1526 | Just hmi <- old_hmi, Just l <- hm_linkable hmi =
1527 null (linkableUnlinked l)
1529 -- we have no linkable, so it cannot be fake
1532 implies False _ = True
1538 -- Regardless of whether we're generating object code or
1539 -- byte code, we can always use an existing object file
1540 -- if it is *stable* (see checkStability).
1541 | is_stable_obj, Just hmi <- old_hmi -> do
1542 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1543 (text "skipping stable obj mod:" <+> ppr this_mod_name)
1545 -- object is stable, and we have an entry in the
1546 -- old HPT: nothing to do
1548 | is_stable_obj, isNothing old_hmi -> do
1549 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1550 (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
1551 linkable <- liftIO $ findObjectLinkable this_mod obj_fn
1552 (expectJust "upsweep1" mb_obj_date)
1553 compile_it (Just linkable)
1554 -- object is stable, but we need to load the interface
1555 -- off disk to make a HMI.
1557 | not (isObjectTarget target), is_stable_bco,
1558 (target /= HscNothing) `implies` not is_fake_linkable ->
1559 ASSERT(isJust old_hmi) -- must be in the old_hpt
1560 let Just hmi = old_hmi in do
1561 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1562 (text "skipping stable BCO mod:" <+> ppr this_mod_name)
1564 -- BCO is stable: nothing to do
1566 | not (isObjectTarget target),
1567 Just hmi <- old_hmi,
1568 Just l <- hm_linkable hmi,
1569 not (isObjectLinkable l),
1570 (target /= HscNothing) `implies` not is_fake_linkable,
1571 linkableTime l >= ms_hs_date summary -> do
1572 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1573 (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
1575 -- we have an old BCO that is up to date with respect
1576 -- to the source: do a recompilation check as normal.
1578 -- When generating object code, if there's an up-to-date
1579 -- object file on the disk, then we can use it.
1580 -- However, if the object file is new (compared to any
1581 -- linkable we had from a previous compilation), then we
1582 -- must discard any in-memory interface, because this
1583 -- means the user has compiled the source file
1584 -- separately and generated a new interface, that we must
1585 -- read from the disk.
1587 | isObjectTarget target,
1588 Just obj_date <- mb_obj_date,
1589 obj_date >= hs_date -> do
1592 | Just l <- hm_linkable hmi,
1593 isObjectLinkable l && linkableTime l == obj_date -> do
1594 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1595 (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
1598 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1599 (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
1600 linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
1601 compile_it_discard_iface (Just linkable)
1604 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1605 (text "compiling mod:" <+> ppr this_mod_name)
1610 -- Filter modules in the HPT
1611 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1612 retainInTopLevelEnvs keep_these hpt
1613 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1615 , let mb_mod_info = lookupUFM hpt mod
1616 , isJust mb_mod_info ]
1618 -- ---------------------------------------------------------------------------
1619 -- Typecheck module loops
1622 See bug #930. This code fixes a long-standing bug in --make. The
1623 problem is that when compiling the modules *inside* a loop, a data
1624 type that is only defined at the top of the loop looks opaque; but
1625 after the loop is done, the structure of the data type becomes
1628 The difficulty is then that two different bits of code have
1629 different notions of what the data type looks like.
1631 The idea is that after we compile a module which also has an .hs-boot
1632 file, we re-generate the ModDetails for each of the modules that
1633 depends on the .hs-boot file, so that everyone points to the proper
1634 TyCons, Ids etc. defined by the real module, not the boot module.
1635 Fortunately re-generating a ModDetails from a ModIface is easy: the
1636 function TcIface.typecheckIface does exactly that.
1638 Picking the modules to re-typecheck is slightly tricky. Starting from
1639 the module graph consisting of the modules that have already been
1640 compiled, we reverse the edges (so they point from the imported module
1641 to the importing module), and depth-first-search from the .hs-boot
1642 node. This gives us all the modules that depend transitively on the
1643 .hs-boot module, and those are exactly the modules that we need to
1646 Following this fix, GHC can compile itself with --make -O2.
1649 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1650 reTypecheckLoop hsc_env ms graph
1651 | not (isBootSummary ms) &&
1652 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1654 let mss = reachableBackwards (ms_mod_name ms) graph
1655 non_boot = filter (not.isBootSummary) mss
1656 debugTraceMsg (hsc_dflags hsc_env) 2 $
1657 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1658 typecheckLoop hsc_env (map ms_mod_name non_boot)
1662 this_mod = ms_mod ms
1664 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1665 typecheckLoop hsc_env mods = do
1667 fixIO $ \new_hpt -> do
1668 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1669 mds <- initIfaceCheck new_hsc_env $
1670 mapM (typecheckIface . hm_iface) hmis
1671 let new_hpt = addListToUFM old_hpt
1672 (zip mods [ hmi{ hm_details = details }
1673 | (hmi,details) <- zip hmis mds ])
1675 return hsc_env{ hsc_HPT = new_hpt }
1677 old_hpt = hsc_HPT hsc_env
1678 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1680 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1681 reachableBackwards mod summaries
1682 = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
1683 where -- the rest just sets up the graph:
1684 (graph, lookup_node) = moduleGraphNodes False summaries
1685 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
1687 -- ---------------------------------------------------------------------------
1688 -- Topological sort of the module graph
1690 type SummaryNode = (ModSummary, Int, [Int])
1694 -- ^ Drop hi-boot nodes? (see below)
1697 -- ^ Root module name. If @Nothing@, use the full graph.
1699 -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1700 -- The resulting list of strongly-connected-components is in topologically
1701 -- sorted order, starting with the module(s) at the bottom of the
1702 -- dependency graph (ie compile them first) and ending with the ones at
1705 -- Drop hi-boot nodes (first boolean arg)?
1707 -- - @False@: treat the hi-boot summaries as nodes of the graph,
1708 -- so the graph must be acyclic
1710 -- - @True@: eliminate the hi-boot nodes, and instead pretend
1711 -- the a source-import of Foo is an import of Foo
1712 -- The resulting graph has no hi-boot nodes, but can be cyclic
1714 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
1715 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
1717 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
1719 initial_graph = case mb_root_mod of
1722 -- restrict the graph to just those modules reachable from
1723 -- the specified module. We do this by building a graph with
1724 -- the full set of nodes, and determining the reachable set from
1725 -- the specified node.
1726 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
1727 | otherwise = ghcError (ProgramError "module does not exist")
1728 in graphFromEdgedVertices (seq root (reachableG graph root))
1730 summaryNodeKey :: SummaryNode -> Int
1731 summaryNodeKey (_, k, _) = k
1733 summaryNodeSummary :: SummaryNode -> ModSummary
1734 summaryNodeSummary (s, _, _) = s
1736 moduleGraphNodes :: Bool -> [ModSummary]
1737 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
1738 moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
1740 numbered_summaries = zip summaries [1..]
1742 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
1743 lookup_node hs_src mod = Map.lookup (mod, hs_src) node_map
1745 lookup_key :: HscSource -> ModuleName -> Maybe Int
1746 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
1748 node_map :: NodeMap SummaryNode
1749 node_map = Map.fromList [ ((moduleName (ms_mod s), ms_hsc_src s), node)
1750 | node@(s, _, _) <- nodes ]
1752 -- We use integers as the keys for the SCC algorithm
1753 nodes :: [SummaryNode]
1754 nodes = [ (s, key, out_keys)
1755 | (s, key) <- numbered_summaries
1756 -- Drop the hi-boot ones if told to do so
1757 , not (isBootSummary s && drop_hs_boot_nodes)
1758 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
1759 out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++
1760 (-- see [boot-edges] below
1761 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1763 else case lookup_key HsBootFile (ms_mod_name s) of
1767 -- [boot-edges] if this is a .hs and there is an equivalent
1768 -- .hs-boot, add a link from the former to the latter. This
1769 -- has the effect of detecting bogus cases where the .hs-boot
1770 -- depends on the .hs, by introducing a cycle. Additionally,
1771 -- it ensures that we will always process the .hs-boot before
1772 -- the .hs, and so the HomePackageTable will always have the
1773 -- most up to date information.
1775 -- Drop hs-boot nodes by using HsSrcFile as the key
1776 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1777 | otherwise = HsBootFile
1779 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1780 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1781 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1782 -- the IsBootInterface parameter True; else False
1785 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1786 type NodeMap a = Map NodeKey a -- keyed by (mod, src_file_type) pairs
1788 msKey :: ModSummary -> NodeKey
1789 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1791 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1792 mkNodeMap summaries = Map.fromList [ (msKey s, s) | s <- summaries]
1794 nodeMapElts :: NodeMap a -> [a]
1795 nodeMapElts = Map.elems
1797 -- | If there are {-# SOURCE #-} imports between strongly connected
1798 -- components in the topological sort, then those imports can
1799 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1800 -- were necessary, then the edge would be part of a cycle.
1801 warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
1802 warnUnnecessarySourceImports sccs = do
1803 logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
1805 let mods_in_this_cycle = map ms_mod_name ms in
1806 [ warn i | m <- ms, i <- ms_home_srcimps m,
1807 unLoc i `notElem` mods_in_this_cycle ]
1809 warn :: Located ModuleName -> WarnMsg
1812 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1813 <+> quotes (ppr mod))
1815 -----------------------------------------------------------------------------
1816 -- Downsweep (dependency analysis)
1818 -- Chase downwards from the specified root set, returning summaries
1819 -- for all home modules encountered. Only follow source-import
1822 -- We pass in the previous collection of summaries, which is used as a
1823 -- cache to avoid recalculating a module summary if the source is
1826 -- The returned list of [ModSummary] nodes has one node for each home-package
1827 -- module, plus one for any hs-boot files. The imports of these nodes
1828 -- are all there, including the imports of non-home-package modules.
1831 -> [ModSummary] -- Old summaries
1832 -> [ModuleName] -- Ignore dependencies on these; treat
1833 -- them as if they were package modules
1834 -> Bool -- True <=> allow multiple targets to have
1835 -- the same module name; this is
1836 -- very useful for ghc -M
1838 -- The elts of [ModSummary] all have distinct
1839 -- (Modules, IsBoot) identifiers, unless the Bool is true
1840 -- in which case there can be repeats
1841 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1843 rootSummaries <- mapM getRootSummary roots
1844 let root_map = mkRootMap rootSummaries
1845 checkDuplicates root_map
1846 summs <- loop (concatMap msDeps rootSummaries) root_map
1849 roots = hsc_targets hsc_env
1851 old_summary_map :: NodeMap ModSummary
1852 old_summary_map = mkNodeMap old_summaries
1854 getRootSummary :: Target -> IO ModSummary
1855 getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
1856 = do exists <- liftIO $ doesFileExist file
1858 then summariseFile hsc_env old_summaries file mb_phase
1859 obj_allowed maybe_buf
1860 else throwOneError $ mkPlainErrMsg noSrcSpan $
1861 text "can't find file:" <+> text file
1862 getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
1863 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1864 (L rootLoc modl) obj_allowed
1866 case maybe_summary of
1867 Nothing -> packageModErr modl
1870 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1872 -- In a root module, the filename is allowed to diverge from the module
1873 -- name, so we have to check that there aren't multiple root files
1874 -- defining the same module (otherwise the duplicates will be silently
1875 -- ignored, leading to confusing behaviour).
1876 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1877 checkDuplicates root_map
1878 | allow_dup_roots = return ()
1879 | null dup_roots = return ()
1880 | otherwise = liftIO $ multiRootsErr (head dup_roots)
1882 dup_roots :: [[ModSummary]] -- Each at least of length 2
1883 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1885 loop :: [(Located ModuleName,IsBootInterface)]
1886 -- Work list: process these modules
1887 -> NodeMap [ModSummary]
1888 -- Visited set; the range is a list because
1889 -- the roots can have the same module names
1890 -- if allow_dup_roots is True
1892 -- The result includes the worklist, except
1893 -- for those mentioned in the visited set
1894 loop [] done = return (concat (nodeMapElts done))
1895 loop ((wanted_mod, is_boot) : ss) done
1896 | Just summs <- Map.lookup key done
1897 = if isSingleton summs then
1900 do { multiRootsErr summs; return [] }
1902 = do mb_s <- summariseModule hsc_env old_summary_map
1903 is_boot wanted_mod True
1906 Nothing -> loop ss done
1907 Just s -> loop (msDeps s ++ ss) (Map.insert key [s] done)
1909 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1911 -- XXX Does the (++) here need to be flipped?
1912 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1913 mkRootMap summaries = Map.insertListWith (flip (++))
1914 [ (msKey s, [s]) | s <- summaries ]
1917 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1918 -- (msDeps s) returns the dependencies of the ModSummary s.
1919 -- A wrinkle is that for a {-# SOURCE #-} import we return
1920 -- *both* the hs-boot file
1921 -- *and* the source file
1922 -- as "dependencies". That ensures that the list of all relevant
1923 -- modules always contains B.hs if it contains B.hs-boot.
1924 -- Remember, this pass isn't doing the topological sort. It's
1925 -- just gathering the list of all relevant ModSummaries
1927 concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ]
1928 ++ [ (m,False) | m <- ms_home_imps s ]
1930 home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
1931 home_imps imps = [ ideclName i | L _ i <- imps, isLocal (ideclPkgQual i) ]
1932 where isLocal Nothing = True
1933 isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
1936 ms_home_allimps :: ModSummary -> [ModuleName]
1937 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
1939 ms_home_srcimps :: ModSummary -> [Located ModuleName]
1940 ms_home_srcimps = home_imps . ms_srcimps
1942 ms_home_imps :: ModSummary -> [Located ModuleName]
1943 ms_home_imps = home_imps . ms_imps
1945 -----------------------------------------------------------------------------
1946 -- Summarising modules
1948 -- We have two types of summarisation:
1950 -- * Summarise a file. This is used for the root module(s) passed to
1951 -- cmLoadModules. The file is read, and used to determine the root
1952 -- module name. The module name may differ from the filename.
1954 -- * Summarise a module. We are given a module name, and must provide
1955 -- a summary. The finder is used to locate the file in which the module
1960 -> [ModSummary] -- old summaries
1961 -> FilePath -- source file name
1962 -> Maybe Phase -- start phase
1963 -> Bool -- object code allowed?
1964 -> Maybe (StringBuffer,ClockTime)
1967 summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
1968 -- we can use a cached summary if one is available and the
1969 -- source file hasn't changed, But we have to look up the summary
1970 -- by source file, rather than module name as we do in summarise.
1971 | Just old_summary <- findSummaryBySourceFile old_summaries file
1973 let location = ms_location old_summary
1975 -- return the cached summary if the source didn't change
1976 src_timestamp <- case maybe_buf of
1977 Just (_,t) -> return t
1978 Nothing -> liftIO $ getModificationTime file
1979 -- The file exists; we checked in getRootSummary above.
1980 -- If it gets removed subsequently, then this
1981 -- getModificationTime may fail, but that's the right
1984 if ms_hs_date old_summary == src_timestamp
1985 then do -- update the object-file timestamp
1987 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1988 || obj_allowed -- bug #1205
1989 then liftIO $ getObjTimestamp location False
1991 return old_summary{ ms_obj_date = obj_timestamp }
1999 let dflags = hsc_dflags hsc_env
2001 (dflags', hspp_fn, buf)
2002 <- preprocessFile hsc_env file mb_phase maybe_buf
2004 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
2006 -- Make a ModLocation for this file
2007 location <- liftIO $ mkHomeModLocation dflags mod_name file
2009 -- Tell the Finder cache where it is, so that subsequent calls
2010 -- to findModule will find it, even if it's not on any search path
2011 mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
2013 src_timestamp <- case maybe_buf of
2014 Just (_,t) -> return t
2015 Nothing -> liftIO $ getModificationTime file
2016 -- getMofificationTime may fail
2018 -- when the user asks to load a source file by name, we only
2019 -- use an object file if -fobject-code is on. See #1205.
2021 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2022 || obj_allowed -- bug #1205
2023 then liftIO $ modificationTimeIfExists (ml_obj_file location)
2026 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
2027 ms_location = location,
2028 ms_hspp_file = hspp_fn,
2029 ms_hspp_opts = dflags',
2030 ms_hspp_buf = Just buf,
2031 ms_srcimps = srcimps, ms_imps = the_imps,
2032 ms_hs_date = src_timestamp,
2033 ms_obj_date = obj_timestamp })
2035 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
2036 findSummaryBySourceFile summaries file
2037 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
2038 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
2042 -- Summarise a module, and pick up source and timestamp.
2045 -> NodeMap ModSummary -- Map of old summaries
2046 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
2047 -> Located ModuleName -- Imported module to be summarised
2048 -> Bool -- object code allowed?
2049 -> Maybe (StringBuffer, ClockTime)
2050 -> [ModuleName] -- Modules to exclude
2051 -> IO (Maybe ModSummary) -- Its new summary
2053 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
2054 obj_allowed maybe_buf excl_mods
2055 | wanted_mod `elem` excl_mods
2058 | Just old_summary <- Map.lookup (wanted_mod, hsc_src) old_summary_map
2059 = do -- Find its new timestamp; all the
2060 -- ModSummaries in the old map have valid ml_hs_files
2061 let location = ms_location old_summary
2062 src_fn = expectJust "summariseModule" (ml_hs_file location)
2064 -- check the modification time on the source file, and
2065 -- return the cached summary if it hasn't changed. If the
2066 -- file has disappeared, we need to call the Finder again.
2068 Just (_,t) -> check_timestamp old_summary location src_fn t
2070 m <- tryIO (getModificationTime src_fn)
2072 Right t -> check_timestamp old_summary location src_fn t
2073 Left e | isDoesNotExistError e -> find_it
2074 | otherwise -> ioError e
2076 | otherwise = find_it
2078 dflags = hsc_dflags hsc_env
2080 hsc_src = if is_boot then HsBootFile else HsSrcFile
2082 check_timestamp old_summary location src_fn src_timestamp
2083 | ms_hs_date old_summary == src_timestamp = do
2084 -- update the object-file timestamp
2086 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2087 || obj_allowed -- bug #1205
2088 then getObjTimestamp location is_boot
2090 return (Just old_summary{ ms_obj_date = obj_timestamp })
2092 -- source changed: re-summarise.
2093 new_summary location (ms_mod old_summary) src_fn src_timestamp
2096 -- Don't use the Finder's cache this time. If the module was
2097 -- previously a package module, it may have now appeared on the
2098 -- search path, so we want to consider it to be a home module. If
2099 -- the module was previously a home module, it may have moved.
2100 uncacheModule hsc_env wanted_mod
2101 found <- findImportedModule hsc_env wanted_mod Nothing
2104 | isJust (ml_hs_file location) ->
2106 just_found location mod
2108 -- Drop external-pkg
2109 ASSERT(modulePackageId mod /= thisPackage dflags)
2112 err -> noModError dflags loc wanted_mod err
2115 just_found location mod = do
2116 -- Adjust location to point to the hs-boot source file,
2117 -- hi file, object file, when is_boot says so
2118 let location' | is_boot = addBootSuffixLocn location
2119 | otherwise = location
2120 src_fn = expectJust "summarise2" (ml_hs_file location')
2122 -- Check that it exists
2123 -- It might have been deleted since the Finder last found it
2124 maybe_t <- modificationTimeIfExists src_fn
2126 Nothing -> noHsFileErr loc src_fn
2127 Just t -> new_summary location' mod src_fn t
2130 new_summary location mod src_fn src_timestamp
2132 -- Preprocess the source file and get its imports
2133 -- The dflags' contains the OPTIONS pragmas
2134 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
2135 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
2137 when (mod_name /= wanted_mod) $
2138 throwOneError $ mkPlainErrMsg mod_loc $
2139 text "File name does not match module name:"
2140 $$ text "Saw:" <+> quotes (ppr mod_name)
2141 $$ text "Expected:" <+> quotes (ppr wanted_mod)
2143 -- Find the object timestamp, and return the summary
2145 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2146 || obj_allowed -- bug #1205
2147 then getObjTimestamp location is_boot
2150 return (Just (ModSummary { ms_mod = mod,
2151 ms_hsc_src = hsc_src,
2152 ms_location = location,
2153 ms_hspp_file = hspp_fn,
2154 ms_hspp_opts = dflags',
2155 ms_hspp_buf = Just buf,
2156 ms_srcimps = srcimps,
2158 ms_hs_date = src_timestamp,
2159 ms_obj_date = obj_timestamp }))
2162 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
2163 getObjTimestamp location is_boot
2164 = if is_boot then return Nothing
2165 else modificationTimeIfExists (ml_obj_file location)
2168 preprocessFile :: HscEnv
2170 -> Maybe Phase -- ^ Starting phase
2171 -> Maybe (StringBuffer,ClockTime)
2172 -> IO (DynFlags, FilePath, StringBuffer)
2173 preprocessFile hsc_env src_fn mb_phase Nothing
2175 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
2176 buf <- hGetStringBuffer hspp_fn
2177 return (dflags', hspp_fn, buf)
2179 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
2181 let dflags = hsc_dflags hsc_env
2182 -- case we bypass the preprocessing stage?
2184 local_opts = getOptions dflags buf src_fn
2186 (dflags', leftovers, warns)
2187 <- parseDynamicNoPackageFlags dflags local_opts
2188 checkProcessArgsResult leftovers
2189 handleFlagWarnings dflags' warns
2193 | Just (Unlit _) <- mb_phase = True
2194 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
2195 -- note: local_opts is only required if there's no Unlit phase
2196 | xopt Opt_Cpp dflags' = True
2197 | dopt Opt_Pp dflags' = True
2200 when needs_preprocessing $
2201 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
2203 return (dflags', src_fn, buf)
2206 -----------------------------------------------------------------------------
2208 -----------------------------------------------------------------------------
2210 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
2211 -- ToDo: we don't have a proper line number for this error
2212 noModError dflags loc wanted_mod err
2213 = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
2215 noHsFileErr :: SrcSpan -> String -> IO a
2216 noHsFileErr loc path
2217 = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
2219 packageModErr :: ModuleName -> IO a
2221 = throwOneError $ mkPlainErrMsg noSrcSpan $
2222 text "module" <+> quotes (ppr mod) <+> text "is a package module"
2224 multiRootsErr :: [ModSummary] -> IO ()
2225 multiRootsErr [] = panic "multiRootsErr"
2226 multiRootsErr summs@(summ1:_)
2227 = throwOneError $ mkPlainErrMsg noSrcSpan $
2228 text "module" <+> quotes (ppr mod) <+>
2229 text "is defined in multiple files:" <+>
2230 sep (map text files)
2233 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
2235 cyclicModuleErr :: [ModSummary] -> SDoc
2237 = hang (ptext (sLit "Module imports form a cycle for modules:"))
2238 2 (vcat (map show_one ms))
2240 mods_in_cycle = map ms_mod_name ms
2241 imp_modname = unLoc . ideclName . unLoc
2242 just_in_cycle = filter ((`elem` mods_in_cycle) . imp_modname)
2245 vcat [ show_mod (ms_hsc_src ms) (ms_mod_name ms) <+>
2246 maybe empty (parens . text) (ml_hs_file (ms_location ms)),
2247 nest 2 $ ptext (sLit "imports:") <+> vcat [
2248 pp_imps HsBootFile (just_in_cycle $ ms_srcimps ms),
2249 pp_imps HsSrcFile (just_in_cycle $ ms_imps ms) ]
2251 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
2252 pp_imps src imps = fsep (map (show_mod src . unLoc . ideclName . unLoc) imps)
2255 -- | Inform GHC that the working directory has changed. GHC will flush
2256 -- its cache of module locations, since it may no longer be valid.
2258 -- Note: Before changing the working directory make sure all threads running
2259 -- in the same session have stopped. If you change the working directory,
2260 -- you should also unload the current program (set targets to empty,
2261 -- followed by load).
2262 workingDirectoryChanged :: GhcMonad m => m ()
2263 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
2265 -- -----------------------------------------------------------------------------
2266 -- inspecting the session
2268 -- | Get the module dependency graph.
2269 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
2270 getModuleGraph = liftM hsc_mod_graph getSession
2272 -- | Determines whether a set of modules requires Template Haskell.
2274 -- Note that if the session's 'DynFlags' enabled Template Haskell when
2275 -- 'depanal' was called, then each module in the returned module graph will
2276 -- have Template Haskell enabled whether it is actually needed or not.
2277 needsTemplateHaskell :: ModuleGraph -> Bool
2278 needsTemplateHaskell ms =
2279 any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms
2281 -- | Return @True@ <==> module is loaded.
2282 isLoaded :: GhcMonad m => ModuleName -> m Bool
2283 isLoaded m = withSession $ \hsc_env ->
2284 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
2286 -- | Return the bindings for the current interactive session.
2287 getBindings :: GhcMonad m => m [TyThing]
2288 getBindings = withSession $ \hsc_env ->
2289 -- we have to implement the shadowing behaviour of ic_tmp_ids here
2290 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
2292 occ_env = mkOccEnv [ (nameOccName (idName id), AnId id)
2293 | id <- ic_tmp_ids (hsc_IC hsc_env) ]
2295 return (occEnvElts occ_env)
2297 getPrintUnqual :: GhcMonad m => m PrintUnqualified
2298 getPrintUnqual = withSession $ \hsc_env ->
2299 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
2301 -- | Container for information about a 'Module'.
2302 data ModuleInfo = ModuleInfo {
2303 minf_type_env :: TypeEnv,
2304 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
2305 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
2306 minf_instances :: [Instance]
2308 ,minf_modBreaks :: ModBreaks
2310 -- ToDo: this should really contain the ModIface too
2312 -- We don't want HomeModInfo here, because a ModuleInfo applies
2313 -- to package modules too.
2315 -- | Request information about a loaded 'Module'
2316 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
2317 getModuleInfo mdl = withSession $ \hsc_env -> do
2318 let mg = hsc_mod_graph hsc_env
2319 if mdl `elem` map ms_mod mg
2320 then liftIO $ getHomeModuleInfo hsc_env (moduleName mdl)
2322 {- if isHomeModule (hsc_dflags hsc_env) mdl
2324 else -} liftIO $ getPackageModuleInfo hsc_env mdl
2325 -- getPackageModuleInfo will attempt to find the interface, so
2326 -- we don't want to call it for a home module, just in case there
2327 -- was a problem loading the module and the interface doesn't
2328 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
2330 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
2332 getPackageModuleInfo hsc_env mdl = do
2333 mb_avails <- hscGetModuleExports hsc_env mdl
2335 Nothing -> return Nothing
2337 eps <- readIORef (hsc_EPS hsc_env)
2339 names = availsToNameSet avails
2341 tys = [ ty | name <- concatMap availNames avails,
2342 Just ty <- [lookupTypeEnv pte name] ]
2344 return (Just (ModuleInfo {
2345 minf_type_env = mkTypeEnv tys,
2346 minf_exports = names,
2347 minf_rdr_env = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
2348 minf_instances = error "getModuleInfo: instances for package module unimplemented",
2349 minf_modBreaks = emptyModBreaks
2352 getPackageModuleInfo _hsc_env _mdl = do
2353 -- bogusly different for non-GHCI (ToDo)
2357 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
2358 getHomeModuleInfo hsc_env mdl =
2359 case lookupUFM (hsc_HPT hsc_env) mdl of
2360 Nothing -> return Nothing
2362 let details = hm_details hmi
2363 return (Just (ModuleInfo {
2364 minf_type_env = md_types details,
2365 minf_exports = availsToNameSet (md_exports details),
2366 minf_rdr_env = mi_globals $! hm_iface hmi,
2367 minf_instances = md_insts details
2369 ,minf_modBreaks = getModBreaks hmi
2373 -- | The list of top-level entities defined in a module
2374 modInfoTyThings :: ModuleInfo -> [TyThing]
2375 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2377 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2378 modInfoTopLevelScope minf
2379 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2381 modInfoExports :: ModuleInfo -> [Name]
2382 modInfoExports minf = nameSetToList $! minf_exports minf
2384 -- | Returns the instances defined by the specified module.
2385 -- Warning: currently unimplemented for package modules.
2386 modInfoInstances :: ModuleInfo -> [Instance]
2387 modInfoInstances = minf_instances
2389 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2390 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2392 mkPrintUnqualifiedForModule :: GhcMonad m =>
2394 -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
2395 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
2396 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2398 modInfoLookupName :: GhcMonad m =>
2400 -> m (Maybe TyThing) -- XXX: returns a Maybe X
2401 modInfoLookupName minf name = withSession $ \hsc_env -> do
2402 case lookupTypeEnv (minf_type_env minf) name of
2403 Just tyThing -> return (Just tyThing)
2405 eps <- liftIO $ readIORef (hsc_EPS hsc_env)
2406 return $! lookupType (hsc_dflags hsc_env)
2407 (hsc_HPT hsc_env) (eps_PTE eps) name
2410 modInfoModBreaks :: ModuleInfo -> ModBreaks
2411 modInfoModBreaks = minf_modBreaks
2414 isDictonaryId :: Id -> Bool
2416 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2418 -- | Looks up a global name: that is, any top-level name in any
2419 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
2420 -- the interactive context, and therefore does not require a preceding
2422 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
2423 lookupGlobalName name = withSession $ \hsc_env -> do
2424 liftIO $ lookupTypeHscEnv hsc_env name
2426 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
2427 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
2428 ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
2429 return (findAnns deserialize ann_env target)
2432 -- | get the GlobalRdrEnv for a session
2433 getGRE :: GhcMonad m => m GlobalRdrEnv
2434 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2437 -- -----------------------------------------------------------------------------
2439 -- | Return all /external/ modules available in the package database.
2440 -- Modules from the current session (i.e., from the 'HomePackageTable') are
2442 packageDbModules :: GhcMonad m =>
2443 Bool -- ^ Only consider exposed packages.
2445 packageDbModules only_exposed = do
2446 dflags <- getSessionDynFlags
2447 let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
2449 [ mkModule pid modname | p <- pkgs
2450 , not only_exposed || exposed p
2451 , let pid = packageConfigId p
2452 , modname <- exposedModules p ]
2454 -- -----------------------------------------------------------------------------
2455 -- Misc exported utils
2457 dataConType :: DataCon -> Type
2458 dataConType dc = idType (dataConWrapId dc)
2460 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2461 pprParenSymName :: NamedThing a => a -> SDoc
2462 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2464 -- ----------------------------------------------------------------------------
2469 -- - Data and Typeable instances for HsSyn.
2471 -- ToDo: check for small transformations that happen to the syntax in
2472 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2474 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
2475 -- to get from TyCons, Ids etc. to TH syntax (reify).
2477 -- :browse will use either lm_toplev or inspect lm_interface, depending
2478 -- on whether the module is interpreted or not.
2482 -- Extract the filename, stringbuffer content and dynflags associed to a module
2484 -- XXX: Explain pre-conditions
2485 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
2486 getModuleSourceAndFlags mod = do
2487 m <- getModSummary (moduleName mod)
2488 case ml_hs_file $ ms_location m of
2489 Nothing -> throw $ mkApiErr (text "No source available for module " <+> ppr mod)
2490 Just sourceFile -> do
2491 source <- liftIO $ hGetStringBuffer sourceFile
2492 return (sourceFile, source, ms_hspp_opts m)
2495 -- | Return module source as token stream, including comments.
2497 -- The module must be in the module graph and its source must be available.
2498 -- Throws a 'HscTypes.SourceError' on parse error.
2499 getTokenStream :: GhcMonad m => Module -> m [Located Token]
2500 getTokenStream mod = do
2501 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
2502 let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
2503 case lexTokenStream source startLoc flags of
2504 POk _ ts -> return ts
2505 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
2507 -- | Give even more information on the source than 'getTokenStream'
2508 -- This function allows reconstructing the source completely with
2509 -- 'showRichTokenStream'.
2510 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
2511 getRichTokenStream mod = do
2512 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
2513 let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
2514 case lexTokenStream source startLoc flags of
2515 POk _ ts -> return $ addSourceToTokens startLoc source ts
2516 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
2518 -- | Given a source location and a StringBuffer corresponding to this
2519 -- location, return a rich token stream with the source associated to the
2521 addSourceToTokens :: SrcLoc -> StringBuffer -> [Located Token]
2522 -> [(Located Token, String)]
2523 addSourceToTokens _ _ [] = []
2524 addSourceToTokens loc buf (t@(L span _) : ts)
2525 | not (isGoodSrcSpan span) = (t,"") : addSourceToTokens loc buf ts
2526 | otherwise = (t,str) : addSourceToTokens newLoc newBuf ts
2528 (newLoc, newBuf, str) = go "" loc buf
2529 start = srcSpanStart span
2530 end = srcSpanEnd span
2531 go acc loc buf | loc < start = go acc nLoc nBuf
2532 | start <= loc && loc < end = go (ch:acc) nLoc nBuf
2533 | otherwise = (loc, buf, reverse acc)
2534 where (ch, nBuf) = nextChar buf
2535 nLoc = advanceSrcLoc loc ch
2538 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
2539 -- return source code almost identical to the original code (except for
2540 -- insignificant whitespace.)
2541 showRichTokenStream :: [(Located Token, String)] -> String
2542 showRichTokenStream ts = go startLoc ts ""
2543 where sourceFile = srcSpanFile (getLoc . fst . head $ ts)
2544 startLoc = mkSrcLoc sourceFile 1 1
2546 go loc ((L span _, str):ts)
2547 | not (isGoodSrcSpan span) = go loc ts
2548 | locLine == tokLine = ((replicate (tokCol - locCol) ' ') ++)
2551 | otherwise = ((replicate (tokLine - locLine) '\n') ++)
2552 . ((replicate tokCol ' ') ++)
2555 where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
2556 (tokLine, tokCol) = (srcSpanStartLine span, srcSpanStartCol span)
2557 tokEnd = srcSpanEnd span
2559 -- -----------------------------------------------------------------------------
2560 -- Interactive evaluation
2562 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2563 -- filesystem and package database to find the corresponding 'Module',
2564 -- using the algorithm that is used for an @import@ declaration.
2565 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
2566 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
2568 dflags = hsc_dflags hsc_env
2569 this_pkg = thisPackage dflags
2572 Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
2573 res <- findImportedModule hsc_env mod_name maybe_pkg
2575 Found _ m -> return m
2576 err -> noModError dflags noSrcSpan mod_name err
2578 home <- lookupLoadedHomeModule mod_name
2581 Nothing -> liftIO $ do
2582 res <- findImportedModule hsc_env mod_name maybe_pkg
2584 Found loc m | modulePackageId m /= this_pkg -> return m
2585 | otherwise -> modNotLoadedError m loc
2586 err -> noModError dflags noSrcSpan mod_name err
2588 modNotLoadedError :: Module -> ModLocation -> IO a
2589 modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $
2590 text "module is not loaded:" <+>
2591 quotes (ppr (moduleName m)) <+>
2592 parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
2594 -- | Like 'findModule', but differs slightly when the module refers to
2595 -- a source file, and the file has not been loaded via 'load'. In
2596 -- this case, 'findModule' will throw an error (module not loaded),
2597 -- but 'lookupModule' will check to see whether the module can also be
2598 -- found in a package, and if so, that package 'Module' will be
2599 -- returned. If not, the usual module-not-found error will be thrown.
2601 lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
2602 lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
2603 lookupModule mod_name Nothing = withSession $ \hsc_env -> do
2604 home <- lookupLoadedHomeModule mod_name
2607 Nothing -> liftIO $ do
2608 res <- findExposedPackageModule hsc_env mod_name Nothing
2610 Found _ m -> return m
2611 err -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
2613 lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
2614 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
2615 case lookupUFM (hsc_HPT hsc_env) mod_name of
2616 Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
2617 _not_a_home_module -> return Nothing
2620 getHistorySpan :: GhcMonad m => History -> m SrcSpan
2621 getHistorySpan h = withSession $ \hsc_env ->
2622 return$ InteractiveEval.getHistorySpan hsc_env h
2624 obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term
2625 obtainTermFromVal bound force ty a =
2626 withSession $ \hsc_env ->
2627 liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
2629 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
2630 obtainTermFromId bound force id =
2631 withSession $ \hsc_env ->
2632 liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
2636 -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
2637 -- entity known to GHC, including 'Name's defined using 'runStmt'.
2638 lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
2640 withSession $ \hsc_env ->
2641 liftIO $ hscTcRcLookupName hsc_env name
2643 -- -----------------------------------------------------------------------------
2646 -- | A pure interface to the module parser.
2648 parser :: String -- ^ Haskell module source text (full Unicode is supported)
2649 -> DynFlags -- ^ the flags
2650 -> FilePath -- ^ the filename (for source locations)
2651 -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
2653 parser str dflags filename =
2655 loc = mkSrcLoc (mkFastString filename) 1 1
2656 buf = stringToStringBuffer str
2658 case unP Parser.parseModule (mkPState dflags buf loc) of
2661 Left (unitBag (mkPlainErrMsg span err))
2663 POk pst rdr_module ->
2664 let (warns,_) = getMessages pst in
2665 Right (warns, rdr_module)