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, runStmtWithLocation,
96 parseImportDecl, SingleStep(..),
98 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
99 resumeHistory, resumeHistoryIx),
100 History(historyBreakInfo, historyEnclosingDecls),
101 GHC.getHistorySpan, getHistoryModule,
104 InteractiveEval.back,
105 InteractiveEval.forward,
108 InteractiveEval.compileExpr, HValue, dynCompileExpr,
109 GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
111 ModBreaks(..), BreakIndex,
112 BreakInfo(breakInfo_number, breakInfo_module),
113 BreakArray, setBreakOn, setBreakOff, getBreak,
117 -- * Abstract syntax elements
123 Module, mkModule, pprModule, moduleName, modulePackageId,
124 ModuleName, mkModuleName, moduleNameString,
128 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
130 RdrName(Qual,Unqual),
134 isImplicitId, isDeadBinder,
135 isExportedId, isLocalId, isGlobalId,
137 isPrimOpId, isFCallId, isClassOpId_maybe,
138 isDataConWorkId, idDataCon,
139 isBottomingId, isDictonaryId,
140 recordSelectorFieldLabel,
142 -- ** Type constructors
144 tyConTyVars, tyConDataCons, tyConArity,
145 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
147 synTyConDefn, synTyConType, synTyConResKind,
153 -- ** Data constructors
155 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
156 dataConIsInfix, isVanillaDataCon, dataConUserType,
158 StrictnessMark(..), isMarkedStrict,
162 classMethods, classSCTheta, classTvsFds,
167 instanceDFunId, pprInstance, pprInstanceHdr,
169 -- ** Types and Kinds
170 Type, splitForAllTys, funResultTy,
171 pprParendType, pprTypeApp,
174 ThetaType, pprForAll, pprThetaArrow,
180 module HsSyn, -- ToDo: remove extraneous bits
184 defaultFixity, maxPrecedence,
188 -- ** Source locations
190 mkSrcLoc, isGoodSrcLoc, noSrcLoc,
191 srcLocFile, srcLocLine, srcLocCol,
193 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
194 srcSpanStart, srcSpanEnd,
196 srcSpanStartLine, srcSpanEndLine,
197 srcSpanStartCol, srcSpanEndCol,
202 -- *** Constructing Located
203 noLoc, mkGeneralLocated,
205 -- *** Deconstructing Located
208 -- *** Combining and comparing Located values
209 eqLocated, cmpLocated, combineLocs, addCLoc,
210 leftmost_smallest, leftmost_largest, rightmost,
214 GhcException(..), showGhcException,
216 -- * Token stream manipulations
218 getTokenStream, getRichTokenStream,
219 showRichTokenStream, addSourceToTokens,
221 -- * Pure interface to the parser
232 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
233 * what StaticFlags should we expose, if any?
236 #include "HsVersions.h"
239 import Linker ( HValue )
242 import InteractiveEval
247 import DriverPipeline ( compile' )
253 import qualified HsSyn -- hack as we want to reexport the whole module
254 import HsSyn hiding ((<.>))
256 import Coercion ( synTyConResKind )
257 import TcType hiding( typeKind )
260 import TysPrim ( alphaTyVars )
265 import Name hiding ( varName )
266 -- import OccName ( parenSymOcc )
269 import CoreSyn ( CoreBind )
271 import DriverPhases ( Phase(..), isHaskellSrcFilename )
275 import StaticFlagParser
276 import qualified StaticFlags
277 import SysTools ( initSysTools, cleanTempFiles,
283 import Bag ( unitBag )
290 import Maybes ( expectJust )
292 import qualified Parser
295 import System.Directory ( doesFileExist, getCurrentDirectory )
297 import Data.List ( find )
298 import Data.Typeable ( Typeable )
299 import Data.Word ( Word8 )
301 import System.Exit ( exitWith, ExitCode(..) )
302 import System.Time ( getClockTime )
305 import System.FilePath
307 import Prelude hiding (init)
310 -- %************************************************************************
312 -- Initialisation: exception handlers
314 -- %************************************************************************
317 -- | Install some default exception handlers and run the inner computation.
318 -- Unless you want to handle exceptions yourself, you should wrap this around
319 -- the top level of your program. The default handlers output the error
320 -- message(s) to stderr and exit cleanly.
321 defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
322 defaultErrorHandler dflags inner =
323 -- top-level exception handler: any unrecognised exception is a compiler bug.
324 ghandle (\exception -> liftIO $ do
326 case fromException exception of
327 -- an IO exception probably isn't our fault, so don't panic
328 Just (ioe :: IOException) ->
329 fatalErrorMsg dflags (text (show ioe))
330 _ -> case fromException exception of
331 Just UserInterrupt -> exitWith (ExitFailure 1)
332 Just StackOverflow ->
333 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
334 _ -> case fromException exception of
335 Just (ex :: ExitCode) -> throw ex
338 (text (show (Panic (show exception))))
339 exitWith (ExitFailure 1)
342 -- error messages propagated as exceptions
347 PhaseFailed _ code -> exitWith code
348 Signal _ -> exitWith (ExitFailure 1)
349 _ -> do fatalErrorMsg dflags (text (show ge))
350 exitWith (ExitFailure 1)
354 -- | Install a default cleanup handler to remove temporary files deposited by
355 -- a GHC run. This is seperate from 'defaultErrorHandler', because you might
356 -- want to override the error handling, but still get the ordinary cleanup
358 defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
359 DynFlags -> m a -> m a
360 defaultCleanupHandler dflags inner =
361 -- make sure we clean up after ourselves
364 cleanTempFiles dflags
367 -- exceptions will be blocked while we clean the temporary files,
368 -- so there shouldn't be any difficulty if we receive further
372 -- %************************************************************************
376 -- %************************************************************************
378 -- | Run function for the 'Ghc' monad.
380 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
381 -- to this function will create a new session which should not be shared among
384 -- Any errors not handled inside the 'Ghc' action are propagated as IO
387 runGhc :: Maybe FilePath -- ^ See argument to 'initGhcMonad'.
388 -> Ghc a -- ^ The action to perform.
390 runGhc mb_top_dir ghc = do
391 ref <- newIORef undefined
392 let session = Session ref
393 flip unGhc session $ do
394 initGhcMonad mb_top_dir
396 -- XXX: unregister interrupt handlers here?
398 -- | Run function for 'GhcT' monad transformer.
400 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
401 -- to this function will create a new session which should not be shared among
404 runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
405 Maybe FilePath -- ^ See argument to 'initGhcMonad'.
406 -> GhcT m a -- ^ The action to perform.
408 runGhcT mb_top_dir ghct = do
409 ref <- liftIO $ newIORef undefined
410 let session = Session ref
411 flip unGhcT session $ do
412 initGhcMonad mb_top_dir
415 -- | Initialise a GHC session.
417 -- If you implement a custom 'GhcMonad' you must call this function in the
418 -- monad run function. It will initialise the session variable and clear all
421 -- The first argument should point to the directory where GHC's library files
422 -- reside. More precisely, this should be the output of @ghc --print-libdir@
423 -- of the version of GHC the module using this API is compiled with. For
424 -- portability, you should use the @ghc-paths@ package, available at
425 -- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
427 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
428 initGhcMonad mb_top_dir = do
430 liftIO $ installSignalHandlers
432 liftIO $ StaticFlags.initStaticOpts
434 dflags0 <- liftIO $ initDynFlags defaultDynFlags
435 dflags <- liftIO $ initSysTools mb_top_dir dflags0
436 env <- liftIO $ newHscEnv dflags
440 -- %************************************************************************
444 -- %************************************************************************
446 -- | Updates the DynFlags in a Session. This also reads
447 -- the package database (unless it has already been read),
448 -- and prepares the compilers knowledge about packages. It
449 -- can be called again to load new packages: just add new
450 -- package flags to (packageFlags dflags).
452 -- Returns a list of new packages that may need to be linked in using
453 -- the dynamic linker (see 'linkPackages') as a result of new package
454 -- flags. If you are not doing linking or doing static linking, you
455 -- can ignore the list of packages returned.
457 setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
458 setSessionDynFlags dflags = do
459 (dflags', preload) <- liftIO $ initPackages dflags
460 modifySession (\h -> h{ hsc_dflags = dflags' })
465 -- %************************************************************************
467 -- Setting, getting, and modifying the targets
469 -- %************************************************************************
471 -- ToDo: think about relative vs. absolute file paths. And what
472 -- happens when the current directory changes.
474 -- | Sets the targets for this session. Each target may be a module name
475 -- or a filename. The targets correspond to the set of root modules for
476 -- the program\/library. Unloading the current program is achieved by
477 -- setting the current set of targets to be empty, followed by 'load'.
478 setTargets :: GhcMonad m => [Target] -> m ()
479 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
481 -- | Returns the current set of targets
482 getTargets :: GhcMonad m => m [Target]
483 getTargets = withSession (return . hsc_targets)
485 -- | Add another target.
486 addTarget :: GhcMonad m => Target -> m ()
488 = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
491 removeTarget :: GhcMonad m => TargetId -> m ()
492 removeTarget target_id
493 = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
495 filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
497 -- | Attempts to guess what Target a string refers to. This function
498 -- implements the @--make@/GHCi command-line syntax for filenames:
500 -- - if the string looks like a Haskell source filename, then interpret it
503 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
506 -- - otherwise interpret the string as a module name
508 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
509 guessTarget str (Just phase)
510 = return (Target (TargetFile str (Just phase)) True Nothing)
511 guessTarget str Nothing
512 | isHaskellSrcFilename file
513 = return (target (TargetFile file Nothing))
515 = do exists <- liftIO $ doesFileExist hs_file
517 then return (target (TargetFile hs_file Nothing))
519 exists <- liftIO $ doesFileExist lhs_file
521 then return (target (TargetFile lhs_file Nothing))
523 if looksLikeModuleName file
524 then return (target (TargetModule (mkModuleName file)))
527 (ProgramError (showSDoc $
528 text "target" <+> quotes (text file) <+>
529 text "is not a module name or a source file"))
532 | '*':rest <- str = (rest, False)
533 | otherwise = (str, True)
535 hs_file = file <.> "hs"
536 lhs_file = file <.> "lhs"
538 target tid = Target tid obj_allowed Nothing
541 -- | Inform GHC that the working directory has changed. GHC will flush
542 -- its cache of module locations, since it may no longer be valid.
544 -- Note: Before changing the working directory make sure all threads running
545 -- in the same session have stopped. If you change the working directory,
546 -- you should also unload the current program (set targets to empty,
547 -- followed by load).
548 workingDirectoryChanged :: GhcMonad m => m ()
549 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
552 -- %************************************************************************
554 -- Running phases one at a time
556 -- %************************************************************************
558 class ParsedMod m where
559 modSummary :: m -> ModSummary
560 parsedSource :: m -> ParsedSource
562 class ParsedMod m => TypecheckedMod m where
563 renamedSource :: m -> Maybe RenamedSource
564 typecheckedSource :: m -> TypecheckedSource
565 moduleInfo :: m -> ModuleInfo
566 tm_internals :: m -> (TcGblEnv, ModDetails)
567 -- ToDo: improvements that could be made here:
568 -- if the module succeeded renaming but not typechecking,
569 -- we can still get back the GlobalRdrEnv and exports, so
570 -- perhaps the ModuleInfo should be split up into separate
573 class TypecheckedMod m => DesugaredMod m where
574 coreModule :: m -> ModGuts
576 -- | The result of successful parsing.
578 ParsedModule { pm_mod_summary :: ModSummary
579 , pm_parsed_source :: ParsedSource }
581 instance ParsedMod ParsedModule where
582 modSummary m = pm_mod_summary m
583 parsedSource m = pm_parsed_source m
585 -- | The result of successful typechecking. It also contains the parser
587 data TypecheckedModule =
588 TypecheckedModule { tm_parsed_module :: ParsedModule
589 , tm_renamed_source :: Maybe RenamedSource
590 , tm_typechecked_source :: TypecheckedSource
591 , tm_checked_module_info :: ModuleInfo
592 , tm_internals_ :: (TcGblEnv, ModDetails)
595 instance ParsedMod TypecheckedModule where
596 modSummary m = modSummary (tm_parsed_module m)
597 parsedSource m = parsedSource (tm_parsed_module m)
599 instance TypecheckedMod TypecheckedModule where
600 renamedSource m = tm_renamed_source m
601 typecheckedSource m = tm_typechecked_source m
602 moduleInfo m = tm_checked_module_info m
603 tm_internals m = tm_internals_ m
605 -- | The result of successful desugaring (i.e., translation to core). Also
606 -- contains all the information of a typechecked module.
607 data DesugaredModule =
608 DesugaredModule { dm_typechecked_module :: TypecheckedModule
609 , dm_core_module :: ModGuts
612 instance ParsedMod DesugaredModule where
613 modSummary m = modSummary (dm_typechecked_module m)
614 parsedSource m = parsedSource (dm_typechecked_module m)
616 instance TypecheckedMod DesugaredModule where
617 renamedSource m = renamedSource (dm_typechecked_module m)
618 typecheckedSource m = typecheckedSource (dm_typechecked_module m)
619 moduleInfo m = moduleInfo (dm_typechecked_module m)
620 tm_internals m = tm_internals_ (dm_typechecked_module m)
622 instance DesugaredMod DesugaredModule where
623 coreModule m = dm_core_module m
625 type ParsedSource = Located (HsModule RdrName)
626 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
628 type TypecheckedSource = LHsBinds Id
631 -- - things that aren't in the output of the typechecker right now:
635 -- - type/data/newtype declarations
636 -- - class declarations
638 -- - extra things in the typechecker's output:
639 -- - default methods are turned into top-level decls.
640 -- - dictionary bindings
642 -- | Return the 'ModSummary' of a module with the given name.
644 -- The module must be part of the module graph (see 'hsc_mod_graph' and
645 -- 'ModuleGraph'). If this is not the case, this function will throw a
648 -- This function ignores boot modules and requires that there is only one
649 -- non-boot module with the given name.
650 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
651 getModSummary mod = do
652 mg <- liftM hsc_mod_graph getSession
653 case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
654 [] -> throw $ mkApiErr (text "Module not part of module graph")
656 multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
660 -- Throws a 'SourceError' on parse error.
661 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
663 hsc_env <- getSession
664 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
665 rdr_module <- liftIO $ hscParse hsc_env_tmp ms
666 return (ParsedModule ms rdr_module)
668 -- | Typecheck and rename a parsed module.
670 -- Throws a 'SourceError' if either fails.
671 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
672 typecheckModule pmod = do
673 let ms = modSummary pmod
674 hsc_env <- getSession
675 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
676 (tc_gbl_env, rn_info)
677 <- liftIO $ hscTypecheckRename hsc_env_tmp ms (parsedSource pmod)
678 details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
681 tm_internals_ = (tc_gbl_env, details),
682 tm_parsed_module = pmod,
683 tm_renamed_source = rn_info,
684 tm_typechecked_source = tcg_binds tc_gbl_env,
685 tm_checked_module_info =
687 minf_type_env = md_types details,
688 minf_exports = availsToNameSet $ md_exports details,
689 minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
690 minf_instances = md_insts details
692 ,minf_modBreaks = emptyModBreaks
696 -- | Desugar a typechecked module.
697 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
698 desugarModule tcm = do
699 let ms = modSummary tcm
700 let (tcg, _) = tm_internals tcm
701 hsc_env <- getSession
702 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
703 guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg
706 dm_typechecked_module = tcm,
707 dm_core_module = guts
710 -- | Load a module. Input doesn't need to be desugared.
712 -- A module must be loaded before dependent modules can be typechecked. This
713 -- always includes generating a 'ModIface' and, depending on the
714 -- 'DynFlags.hscTarget', may also include code generation.
716 -- This function will always cause recompilation and will always overwrite
717 -- previous compilation results (potentially files on disk).
719 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
721 let ms = modSummary tcm
722 let mod = ms_mod_name ms
723 let loc = ms_location ms
724 let (tcg, _details) = tm_internals tcm
726 mb_linkable <- case ms_obj_date ms of
727 Just t | t > ms_hs_date ms -> do
728 l <- liftIO $ findObjectLinkable (ms_mod ms)
731 _otherwise -> return Nothing
733 -- compile doesn't change the session
734 hsc_env <- getSession
735 mod_info <- liftIO $ compile' (hscNothingBackendOnly tcg,
736 hscInteractiveBackendOnly tcg,
737 hscBatchBackendOnly tcg)
738 hsc_env ms 1 1 Nothing mb_linkable
740 modifySession $ \e -> e{ hsc_HPT = addToUFM (hsc_HPT e) mod mod_info }
744 -- %************************************************************************
748 -- %************************************************************************
750 -- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
751 -- the 'GHC.compileToCoreModule' interface.
755 cm_module :: !Module,
756 -- | Type environment for types declared in this module
757 cm_types :: !TypeEnv,
759 cm_binds :: [CoreBind]
762 instance Outputable CoreModule where
763 ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb}) =
764 text "%module" <+> ppr mn <+> ppr te $$ vcat (map ppr cb)
766 -- | This is the way to get access to the Core bindings corresponding
767 -- to a module. 'compileToCore' parses, typechecks, and
768 -- desugars the module, then returns the resulting Core module (consisting of
769 -- the module name, type declarations, and function declarations) if
771 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
772 compileToCoreModule = compileCore False
774 -- | Like compileToCoreModule, but invokes the simplifier, so
775 -- as to return simplified and tidied Core.
776 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
777 compileToCoreSimplified = compileCore True
779 -- | Provided for backwards-compatibility: compileToCore returns just the Core
780 -- bindings, but for most purposes, you probably want to call
781 -- compileToCoreModule.
782 compileToCore :: GhcMonad m => FilePath -> m [CoreBind]
783 compileToCore fn = do
784 mod <- compileToCoreModule session fn
785 return $ cm_binds mod
787 -- | Takes a CoreModule and compiles the bindings therein
788 -- to object code. The first argument is a bool flag indicating
789 -- whether to run the simplifier.
790 -- The resulting .o, .hi, and executable files, if any, are stored in the
791 -- current directory, and named according to the module name.
792 -- This has only so far been tested with a single self-contained module.
793 compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
794 compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
795 dflags <- getSessionDynFlags
796 currentTime <- liftIO $ getClockTime
797 cwd <- liftIO $ getCurrentDirectory
798 modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
799 ((moduleNameSlashes . moduleName) mName)
801 let modSummary = ModSummary { ms_mod = mName,
802 ms_hsc_src = ExtCoreFile,
803 ms_location = modLocation,
804 -- By setting the object file timestamp to Nothing,
805 -- we always force recompilation, which is what we
806 -- want. (Thus it doesn't matter what the timestamp
807 -- for the (nonexistent) source file is.)
808 ms_hs_date = currentTime,
809 ms_obj_date = Nothing,
810 -- Only handling the single-module case for now, so no imports.
815 ms_hspp_opts = dflags,
816 ms_hspp_buf = Nothing
819 hsc_env <- getSession
820 liftIO $ hscCompileCore hsc_env simplify modSummary (cm_binds cm)
823 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
824 compileCore simplify fn = do
825 -- First, set the target to the desired filename
826 target <- guessTarget fn Nothing
828 _ <- load LoadAllTargets
829 -- Then find dependencies
830 modGraph <- depanal [] True
831 case find ((== fn) . msHsFilePath) modGraph of
832 Just modSummary -> do
833 -- Now we have the module name;
834 -- parse, typecheck and desugar the module
835 mod_guts <- coreModule `fmap`
836 -- TODO: space leaky: call hsc* directly?
837 (desugarModule =<< typecheckModule =<< parseModule modSummary)
838 liftM gutsToCoreModule $
841 -- If simplify is true: simplify (hscSimplify), then tidy
843 hsc_env <- getSession
844 simpl_guts <- liftIO $ hscSimplify hsc_env mod_guts
845 tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
846 return $ Left tidy_guts
848 return $ Right mod_guts
850 Nothing -> panic "compileToCoreModule: target FilePath not found in\
851 module dependency graph"
852 where -- two versions, based on whether we simplify (thus run tidyProgram,
853 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
854 -- we just have a ModGuts.
855 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
856 gutsToCoreModule (Left (cg, md)) = CoreModule {
857 cm_module = cg_module cg, cm_types = md_types md,
858 cm_binds = cg_binds cg
860 gutsToCoreModule (Right mg) = CoreModule {
861 cm_module = mg_module mg, cm_types = mg_types mg,
862 cm_binds = mg_binds mg
865 -- %************************************************************************
867 -- Inspecting the session
869 -- %************************************************************************
871 -- | Get the module dependency graph.
872 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
873 getModuleGraph = liftM hsc_mod_graph getSession
875 -- | Determines whether a set of modules requires Template Haskell.
877 -- Note that if the session's 'DynFlags' enabled Template Haskell when
878 -- 'depanal' was called, then each module in the returned module graph will
879 -- have Template Haskell enabled whether it is actually needed or not.
880 needsTemplateHaskell :: ModuleGraph -> Bool
881 needsTemplateHaskell ms =
882 any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms
884 -- | Return @True@ <==> module is loaded.
885 isLoaded :: GhcMonad m => ModuleName -> m Bool
886 isLoaded m = withSession $ \hsc_env ->
887 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
889 -- | Return the bindings for the current interactive session.
890 getBindings :: GhcMonad m => m [TyThing]
891 getBindings = withSession $ \hsc_env ->
892 -- we have to implement the shadowing behaviour of ic_tmp_ids here
893 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
895 occ_env = mkOccEnv [ (nameOccName (idName id), AnId id)
896 | id <- ic_tmp_ids (hsc_IC hsc_env) ]
898 return (occEnvElts occ_env)
900 getPrintUnqual :: GhcMonad m => m PrintUnqualified
901 getPrintUnqual = withSession $ \hsc_env ->
902 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
904 -- | Container for information about a 'Module'.
905 data ModuleInfo = ModuleInfo {
906 minf_type_env :: TypeEnv,
907 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
908 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
909 minf_instances :: [Instance]
911 ,minf_modBreaks :: ModBreaks
913 -- ToDo: this should really contain the ModIface too
915 -- We don't want HomeModInfo here, because a ModuleInfo applies
916 -- to package modules too.
918 -- | Request information about a loaded 'Module'
919 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
920 getModuleInfo mdl = withSession $ \hsc_env -> do
921 let mg = hsc_mod_graph hsc_env
922 if mdl `elem` map ms_mod mg
923 then liftIO $ getHomeModuleInfo hsc_env (moduleName mdl)
925 {- if isHomeModule (hsc_dflags hsc_env) mdl
927 else -} liftIO $ getPackageModuleInfo hsc_env mdl
928 -- getPackageModuleInfo will attempt to find the interface, so
929 -- we don't want to call it for a home module, just in case there
930 -- was a problem loading the module and the interface doesn't
931 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
933 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
935 getPackageModuleInfo hsc_env mdl = do
936 mb_avails <- hscGetModuleExports hsc_env mdl
938 Nothing -> return Nothing
940 eps <- readIORef (hsc_EPS hsc_env)
942 names = availsToNameSet avails
944 tys = [ ty | name <- concatMap availNames avails,
945 Just ty <- [lookupTypeEnv pte name] ]
947 return (Just (ModuleInfo {
948 minf_type_env = mkTypeEnv tys,
949 minf_exports = names,
950 minf_rdr_env = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
951 minf_instances = error "getModuleInfo: instances for package module unimplemented",
952 minf_modBreaks = emptyModBreaks
955 getPackageModuleInfo _hsc_env _mdl = do
956 -- bogusly different for non-GHCI (ToDo)
960 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
961 getHomeModuleInfo hsc_env mdl =
962 case lookupUFM (hsc_HPT hsc_env) mdl of
963 Nothing -> return Nothing
965 let details = hm_details hmi
966 return (Just (ModuleInfo {
967 minf_type_env = md_types details,
968 minf_exports = availsToNameSet (md_exports details),
969 minf_rdr_env = mi_globals $! hm_iface hmi,
970 minf_instances = md_insts details
972 ,minf_modBreaks = getModBreaks hmi
976 -- | The list of top-level entities defined in a module
977 modInfoTyThings :: ModuleInfo -> [TyThing]
978 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
980 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
981 modInfoTopLevelScope minf
982 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
984 modInfoExports :: ModuleInfo -> [Name]
985 modInfoExports minf = nameSetToList $! minf_exports minf
987 -- | Returns the instances defined by the specified module.
988 -- Warning: currently unimplemented for package modules.
989 modInfoInstances :: ModuleInfo -> [Instance]
990 modInfoInstances = minf_instances
992 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
993 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
995 mkPrintUnqualifiedForModule :: GhcMonad m =>
997 -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
998 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
999 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
1001 modInfoLookupName :: GhcMonad m =>
1003 -> m (Maybe TyThing) -- XXX: returns a Maybe X
1004 modInfoLookupName minf name = withSession $ \hsc_env -> do
1005 case lookupTypeEnv (minf_type_env minf) name of
1006 Just tyThing -> return (Just tyThing)
1008 eps <- liftIO $ readIORef (hsc_EPS hsc_env)
1009 return $! lookupType (hsc_dflags hsc_env)
1010 (hsc_HPT hsc_env) (eps_PTE eps) name
1013 modInfoModBreaks :: ModuleInfo -> ModBreaks
1014 modInfoModBreaks = minf_modBreaks
1017 isDictonaryId :: Id -> Bool
1019 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
1021 -- | Looks up a global name: that is, any top-level name in any
1022 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
1023 -- the interactive context, and therefore does not require a preceding
1025 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
1026 lookupGlobalName name = withSession $ \hsc_env -> do
1027 liftIO $ lookupTypeHscEnv hsc_env name
1029 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
1030 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
1031 ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
1032 return (findAnns deserialize ann_env target)
1035 -- | get the GlobalRdrEnv for a session
1036 getGRE :: GhcMonad m => m GlobalRdrEnv
1037 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
1040 -- -----------------------------------------------------------------------------
1042 -- | Return all /external/ modules available in the package database.
1043 -- Modules from the current session (i.e., from the 'HomePackageTable') are
1045 packageDbModules :: GhcMonad m =>
1046 Bool -- ^ Only consider exposed packages.
1048 packageDbModules only_exposed = do
1049 dflags <- getSessionDynFlags
1050 let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
1052 [ mkModule pid modname | p <- pkgs
1053 , not only_exposed || exposed p
1054 , let pid = packageConfigId p
1055 , modname <- exposedModules p ]
1057 -- -----------------------------------------------------------------------------
1058 -- Misc exported utils
1060 dataConType :: DataCon -> Type
1061 dataConType dc = idType (dataConWrapId dc)
1063 -- | print a 'NamedThing', adding parentheses if the name is an operator.
1064 pprParenSymName :: NamedThing a => a -> SDoc
1065 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
1067 -- ----------------------------------------------------------------------------
1072 -- - Data and Typeable instances for HsSyn.
1074 -- ToDo: check for small transformations that happen to the syntax in
1075 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1077 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
1078 -- to get from TyCons, Ids etc. to TH syntax (reify).
1080 -- :browse will use either lm_toplev or inspect lm_interface, depending
1081 -- on whether the module is interpreted or not.
1085 -- Extract the filename, stringbuffer content and dynflags associed to a module
1087 -- XXX: Explain pre-conditions
1088 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
1089 getModuleSourceAndFlags mod = do
1090 m <- getModSummary (moduleName mod)
1091 case ml_hs_file $ ms_location m of
1092 Nothing -> throw $ mkApiErr (text "No source available for module " <+> ppr mod)
1093 Just sourceFile -> do
1094 source <- liftIO $ hGetStringBuffer sourceFile
1095 return (sourceFile, source, ms_hspp_opts m)
1098 -- | Return module source as token stream, including comments.
1100 -- The module must be in the module graph and its source must be available.
1101 -- Throws a 'HscTypes.SourceError' on parse error.
1102 getTokenStream :: GhcMonad m => Module -> m [Located Token]
1103 getTokenStream mod = do
1104 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1105 let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
1106 case lexTokenStream source startLoc flags of
1107 POk _ ts -> return ts
1108 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
1110 -- | Give even more information on the source than 'getTokenStream'
1111 -- This function allows reconstructing the source completely with
1112 -- 'showRichTokenStream'.
1113 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
1114 getRichTokenStream mod = do
1115 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1116 let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
1117 case lexTokenStream source startLoc flags of
1118 POk _ ts -> return $ addSourceToTokens startLoc source ts
1119 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
1121 -- | Given a source location and a StringBuffer corresponding to this
1122 -- location, return a rich token stream with the source associated to the
1124 addSourceToTokens :: SrcLoc -> StringBuffer -> [Located Token]
1125 -> [(Located Token, String)]
1126 addSourceToTokens _ _ [] = []
1127 addSourceToTokens loc buf (t@(L span _) : ts)
1128 | not (isGoodSrcSpan span) = (t,"") : addSourceToTokens loc buf ts
1129 | otherwise = (t,str) : addSourceToTokens newLoc newBuf ts
1131 (newLoc, newBuf, str) = go "" loc buf
1132 start = srcSpanStart span
1133 end = srcSpanEnd span
1134 go acc loc buf | loc < start = go acc nLoc nBuf
1135 | start <= loc && loc < end = go (ch:acc) nLoc nBuf
1136 | otherwise = (loc, buf, reverse acc)
1137 where (ch, nBuf) = nextChar buf
1138 nLoc = advanceSrcLoc loc ch
1141 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
1142 -- return source code almost identical to the original code (except for
1143 -- insignificant whitespace.)
1144 showRichTokenStream :: [(Located Token, String)] -> String
1145 showRichTokenStream ts = go startLoc ts ""
1146 where sourceFile = srcSpanFile (getLoc . fst . head $ ts)
1147 startLoc = mkSrcLoc sourceFile 1 1
1149 go loc ((L span _, str):ts)
1150 | not (isGoodSrcSpan span) = go loc ts
1151 | locLine == tokLine = ((replicate (tokCol - locCol) ' ') ++)
1154 | otherwise = ((replicate (tokLine - locLine) '\n') ++)
1155 . ((replicate tokCol ' ') ++)
1158 where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
1159 (tokLine, tokCol) = (srcSpanStartLine span, srcSpanStartCol span)
1160 tokEnd = srcSpanEnd span
1162 -- -----------------------------------------------------------------------------
1163 -- Interactive evaluation
1165 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
1166 -- filesystem and package database to find the corresponding 'Module',
1167 -- using the algorithm that is used for an @import@ declaration.
1168 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1169 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
1171 dflags = hsc_dflags hsc_env
1172 this_pkg = thisPackage dflags
1175 Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
1176 res <- findImportedModule hsc_env mod_name maybe_pkg
1178 Found _ m -> return m
1179 err -> noModError dflags noSrcSpan mod_name err
1181 home <- lookupLoadedHomeModule mod_name
1184 Nothing -> liftIO $ do
1185 res <- findImportedModule hsc_env mod_name maybe_pkg
1187 Found loc m | modulePackageId m /= this_pkg -> return m
1188 | otherwise -> modNotLoadedError m loc
1189 err -> noModError dflags noSrcSpan mod_name err
1191 modNotLoadedError :: Module -> ModLocation -> IO a
1192 modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $
1193 text "module is not loaded:" <+>
1194 quotes (ppr (moduleName m)) <+>
1195 parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
1197 -- | Like 'findModule', but differs slightly when the module refers to
1198 -- a source file, and the file has not been loaded via 'load'. In
1199 -- this case, 'findModule' will throw an error (module not loaded),
1200 -- but 'lookupModule' will check to see whether the module can also be
1201 -- found in a package, and if so, that package 'Module' will be
1202 -- returned. If not, the usual module-not-found error will be thrown.
1204 lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1205 lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
1206 lookupModule mod_name Nothing = withSession $ \hsc_env -> do
1207 home <- lookupLoadedHomeModule mod_name
1210 Nothing -> liftIO $ do
1211 res <- findExposedPackageModule hsc_env mod_name Nothing
1213 Found _ m -> return m
1214 err -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
1216 lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
1217 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
1218 case lookupUFM (hsc_HPT hsc_env) mod_name of
1219 Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
1220 _not_a_home_module -> return Nothing
1223 getHistorySpan :: GhcMonad m => History -> m SrcSpan
1224 getHistorySpan h = withSession $ \hsc_env ->
1225 return$ InteractiveEval.getHistorySpan hsc_env h
1227 obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term
1228 obtainTermFromVal bound force ty a =
1229 withSession $ \hsc_env ->
1230 liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
1232 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
1233 obtainTermFromId bound force id =
1234 withSession $ \hsc_env ->
1235 liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
1239 -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
1240 -- entity known to GHC, including 'Name's defined using 'runStmt'.
1241 lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
1243 withSession $ \hsc_env ->
1244 liftIO $ hscTcRcLookupName hsc_env name
1246 -- -----------------------------------------------------------------------------
1249 -- | A pure interface to the module parser.
1251 parser :: String -- ^ Haskell module source text (full Unicode is supported)
1252 -> DynFlags -- ^ the flags
1253 -> FilePath -- ^ the filename (for source locations)
1254 -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
1256 parser str dflags filename =
1258 loc = mkSrcLoc (mkFastString filename) 1 1
1259 buf = stringToStringBuffer str
1261 case unP Parser.parseModule (mkPState dflags buf loc) of
1264 Left (unitBag (mkPlainErrMsg span err))
1266 POk pst rdr_module ->
1267 let (warns,_) = getMessages pst in
1268 Right (warns, rdr_module)