Refactor SrcLoc and SrcSpan
[ghc.git] / compiler / main / GHC.hs
1 -- -----------------------------------------------------------------------------
2 --
3 -- (c) The University of Glasgow, 2005
4 --
5 -- The GHC API
6 --
7 -- -----------------------------------------------------------------------------
8
9 module GHC (
10 -- * Initialisation
11 defaultErrorHandler,
12 defaultCleanupHandler,
13
14 -- * GHC Monad
15 Ghc, GhcT, GhcMonad(..),
16 runGhc, runGhcT, initGhcMonad,
17 gcatch, gbracket, gfinally,
18 printException,
19 printExceptionAndWarnings,
20 handleSourceError,
21 needsTemplateHaskell,
22
23 -- * Flags and settings
24 DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
25 GhcMode(..), GhcLink(..), defaultObjectTarget,
26 parseDynamicFlags,
27 getSessionDynFlags,
28 setSessionDynFlags,
29 parseStaticFlags,
30
31 -- * Targets
32 Target(..), TargetId(..), Phase,
33 setTargets,
34 getTargets,
35 addTarget,
36 removeTarget,
37 guessTarget,
38
39 -- * Loading\/compiling the program
40 depanal,
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,
52 compileCoreToObj,
53 getModSummary,
54
55 -- * Inspecting the module structure of the program
56 ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
57 getModuleGraph,
58 isLoaded,
59 topSortModuleGraph,
60
61 -- * Inspecting modules
62 ModuleInfo,
63 getModuleInfo,
64 modInfoTyThings,
65 modInfoTopLevelScope,
66 modInfoExports,
67 modInfoInstances,
68 modInfoIsExportedName,
69 modInfoLookupName,
70 lookupGlobalName,
71 findGlobalAnns,
72 mkPrintUnqualifiedForModule,
73
74 -- * Querying the environment
75 packageDbModules,
76
77 -- * Printing
78 PrintUnqualified, alwaysQualify,
79
80 -- * Interactive evaluation
81 getBindings, getPrintUnqual,
82 findModule,
83 lookupModule,
84 #ifdef GHCI
85 setContext, getContext,
86 getNamesInScope,
87 getRdrNamesInScope,
88 getGRE,
89 moduleIsInterpreted,
90 getInfo,
91 exprType,
92 typeKind,
93 parseName,
94 RunResult(..),
95 runStmt, runStmtWithLocation,
96 parseImportDecl, SingleStep(..),
97 resume,
98 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
99 resumeHistory, resumeHistoryIx),
100 History(historyBreakInfo, historyEnclosingDecls),
101 GHC.getHistorySpan, getHistoryModule,
102 getResumeContext,
103 abandon, abandonAll,
104 InteractiveEval.back,
105 InteractiveEval.forward,
106 showModule,
107 isModuleInterpreted,
108 InteractiveEval.compileExpr, HValue, dynCompileExpr,
109 GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
110 modInfoModBreaks,
111 ModBreaks(..), BreakIndex,
112 BreakInfo(breakInfo_number, breakInfo_module),
113 BreakArray, setBreakOn, setBreakOff, getBreak,
114 #endif
115 lookupName,
116
117 -- * Abstract syntax elements
118
119 -- ** Packages
120 PackageId,
121
122 -- ** Modules
123 Module, mkModule, pprModule, moduleName, modulePackageId,
124 ModuleName, mkModuleName, moduleNameString,
125
126 -- ** Names
127 Name,
128 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
129 NamedThing(..),
130 RdrName(Qual,Unqual),
131
132 -- ** Identifiers
133 Id, idType,
134 isImplicitId, isDeadBinder,
135 isExportedId, isLocalId, isGlobalId,
136 isRecordSelector,
137 isPrimOpId, isFCallId, isClassOpId_maybe,
138 isDataConWorkId, idDataCon,
139 isBottomingId, isDictonaryId,
140 recordSelectorFieldLabel,
141
142 -- ** Type constructors
143 TyCon,
144 tyConTyVars, tyConDataCons, tyConArity,
145 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
146 isFamilyTyCon,
147 synTyConDefn, synTyConType, synTyConResKind,
148
149 -- ** Type variables
150 TyVar,
151 alphaTyVars,
152
153 -- ** Data constructors
154 DataCon,
155 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
156 dataConIsInfix, isVanillaDataCon, dataConUserType,
157 dataConStrictMarks,
158 StrictnessMark(..), isMarkedStrict,
159
160 -- ** Classes
161 Class,
162 classMethods, classSCTheta, classTvsFds,
163 pprFundeps,
164
165 -- ** Instances
166 Instance,
167 instanceDFunId, pprInstance, pprInstanceHdr,
168
169 -- ** Types and Kinds
170 Type, splitForAllTys, funResultTy,
171 pprParendType, pprTypeApp,
172 Kind,
173 PredType,
174 ThetaType, pprForAll, pprThetaArrow, pprThetaArrowTy,
175
176 -- ** Entities
177 TyThing(..),
178
179 -- ** Syntax
180 module HsSyn, -- ToDo: remove extraneous bits
181
182 -- ** Fixities
183 FixityDirection(..),
184 defaultFixity, maxPrecedence,
185 negateFixity,
186 compareFixity,
187
188 -- ** Source locations
189 SrcLoc, pprDefnLoc,
190 mkSrcLoc, noSrcLoc,
191 srcLocFile, srcLocLine, srcLocCol,
192 SrcSpan,
193 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
194 srcSpanStart, srcSpanEnd,
195 srcSpanFile,
196 srcSpanStartLine, srcSpanEndLine,
197 srcSpanStartCol, srcSpanEndCol,
198
199 -- ** Located
200 GenLocated(..), Located,
201
202 -- *** Constructing Located
203 noLoc, mkGeneralLocated,
204
205 -- *** Deconstructing Located
206 getLoc, unLoc,
207
208 -- *** Combining and comparing Located values
209 eqLocated, cmpLocated, combineLocs, addCLoc,
210 leftmost_smallest, leftmost_largest, rightmost,
211 spans, isSubspanOf,
212
213 -- * Exceptions
214 GhcException(..), showGhcException,
215
216 -- * Token stream manipulations
217 Token,
218 getTokenStream, getRichTokenStream,
219 showRichTokenStream, addSourceToTokens,
220
221 -- * Pure interface to the parser
222 parser,
223
224 -- * Miscellaneous
225 --sessionHscEnv,
226 cyclicModuleErr,
227 ) where
228
229 {-
230 ToDo:
231
232 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
233 * what StaticFlags should we expose, if any?
234 -}
235
236 #include "HsVersions.h"
237
238 #ifdef GHCI
239 import Linker ( HValue )
240 import ByteCodeInstr
241 import BreakArray
242 import InteractiveEval
243 #endif
244
245 import HscMain
246 import GhcMake
247 import DriverPipeline ( compile' )
248 import GhcMonad
249 import TcRnTypes
250 import Packages
251 import NameSet
252 import RdrName
253 import qualified HsSyn -- hack as we want to reexport the whole module
254 import HsSyn hiding ((<.>))
255 import Type
256 import Coercion ( synTyConResKind )
257 import TcType hiding( typeKind )
258 import Id
259 import TysPrim ( alphaTyVars )
260 import TyCon
261 import Class
262 -- import FunDeps
263 import DataCon
264 import Name hiding ( varName )
265 -- import OccName ( parenSymOcc )
266 import InstEnv
267 import SrcLoc
268 import CoreSyn ( CoreBind )
269 import TidyPgm
270 import DriverPhases ( Phase(..), isHaskellSrcFilename )
271 import Finder
272 import HscTypes
273 import DynFlags
274 import StaticFlagParser
275 import qualified StaticFlags
276 import SysTools ( initSysTools, cleanTempFiles,
277 cleanTempDirs )
278 import Annotations
279 import Module
280 import UniqFM
281 import Panic
282 import Bag ( unitBag )
283 import ErrUtils
284 import MonadUtils
285 import Util
286 import StringBuffer
287 import Outputable
288 import BasicTypes
289 import Maybes ( expectJust )
290 import FastString
291 import qualified Parser
292 import Lexer
293
294 import System.Directory ( doesFileExist, getCurrentDirectory )
295 import Data.Maybe
296 import Data.List ( find )
297 import Data.Typeable ( Typeable )
298 import Data.Word ( Word8 )
299 import Control.Monad
300 import System.Exit ( exitWith, ExitCode(..) )
301 import System.Time ( getClockTime )
302 import Exception
303 import Data.IORef
304 import System.FilePath
305 import System.IO
306 import Prelude hiding (init)
307
308
309 -- %************************************************************************
310 -- %* *
311 -- Initialisation: exception handlers
312 -- %* *
313 -- %************************************************************************
314
315
316 -- | Install some default exception handlers and run the inner computation.
317 -- Unless you want to handle exceptions yourself, you should wrap this around
318 -- the top level of your program. The default handlers output the error
319 -- message(s) to stderr and exit cleanly.
320 defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
321 defaultErrorHandler dflags inner =
322 -- top-level exception handler: any unrecognised exception is a compiler bug.
323 ghandle (\exception -> liftIO $ do
324 hFlush stdout
325 case fromException exception of
326 -- an IO exception probably isn't our fault, so don't panic
327 Just (ioe :: IOException) ->
328 fatalErrorMsg dflags (text (show ioe))
329 _ -> case fromException exception of
330 Just UserInterrupt -> exitWith (ExitFailure 1)
331 Just StackOverflow ->
332 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
333 _ -> case fromException exception of
334 Just (ex :: ExitCode) -> throw ex
335 _ ->
336 fatalErrorMsg dflags
337 (text (show (Panic (show exception))))
338 exitWith (ExitFailure 1)
339 ) $
340
341 -- error messages propagated as exceptions
342 handleGhcException
343 (\ge -> liftIO $ do
344 hFlush stdout
345 case ge of
346 PhaseFailed _ code -> exitWith code
347 Signal _ -> exitWith (ExitFailure 1)
348 _ -> do fatalErrorMsg dflags (text (show ge))
349 exitWith (ExitFailure 1)
350 ) $
351 inner
352
353 -- | Install a default cleanup handler to remove temporary files deposited by
354 -- a GHC run. This is seperate from 'defaultErrorHandler', because you might
355 -- want to override the error handling, but still get the ordinary cleanup
356 -- behaviour.
357 defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
358 DynFlags -> m a -> m a
359 defaultCleanupHandler dflags inner =
360 -- make sure we clean up after ourselves
361 inner `gfinally`
362 (liftIO $ do
363 cleanTempFiles dflags
364 cleanTempDirs dflags
365 )
366 -- exceptions will be blocked while we clean the temporary files,
367 -- so there shouldn't be any difficulty if we receive further
368 -- signals.
369
370
371 -- %************************************************************************
372 -- %* *
373 -- The Ghc Monad
374 -- %* *
375 -- %************************************************************************
376
377 -- | Run function for the 'Ghc' monad.
378 --
379 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
380 -- to this function will create a new session which should not be shared among
381 -- several threads.
382 --
383 -- Any errors not handled inside the 'Ghc' action are propagated as IO
384 -- exceptions.
385
386 runGhc :: Maybe FilePath -- ^ See argument to 'initGhcMonad'.
387 -> Ghc a -- ^ The action to perform.
388 -> IO a
389 runGhc mb_top_dir ghc = do
390 ref <- newIORef (panic "empty session")
391 let session = Session ref
392 flip unGhc session $ do
393 initGhcMonad mb_top_dir
394 ghc
395 -- XXX: unregister interrupt handlers here?
396
397 -- | Run function for 'GhcT' monad transformer.
398 --
399 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
400 -- to this function will create a new session which should not be shared among
401 -- several threads.
402
403 runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
404 Maybe FilePath -- ^ See argument to 'initGhcMonad'.
405 -> GhcT m a -- ^ The action to perform.
406 -> m a
407 runGhcT mb_top_dir ghct = do
408 ref <- liftIO $ newIORef (panic "empty session")
409 let session = Session ref
410 flip unGhcT session $ do
411 initGhcMonad mb_top_dir
412 ghct
413
414 -- | Initialise a GHC session.
415 --
416 -- If you implement a custom 'GhcMonad' you must call this function in the
417 -- monad run function. It will initialise the session variable and clear all
418 -- warnings.
419 --
420 -- The first argument should point to the directory where GHC's library files
421 -- reside. More precisely, this should be the output of @ghc --print-libdir@
422 -- of the version of GHC the module using this API is compiled with. For
423 -- portability, you should use the @ghc-paths@ package, available at
424 -- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
425
426 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
427 initGhcMonad mb_top_dir = do
428 -- catch ^C
429 liftIO $ installSignalHandlers
430
431 liftIO $ StaticFlags.initStaticOpts
432
433 mySettings <- liftIO $ initSysTools mb_top_dir
434 dflags <- liftIO $ initDynFlags (defaultDynFlags mySettings)
435 env <- liftIO $ newHscEnv dflags
436 setSession env
437
438
439 -- %************************************************************************
440 -- %* *
441 -- Flags & settings
442 -- %* *
443 -- %************************************************************************
444
445 -- | Updates the DynFlags in a Session. This also reads
446 -- the package database (unless it has already been read),
447 -- and prepares the compilers knowledge about packages. It
448 -- can be called again to load new packages: just add new
449 -- package flags to (packageFlags dflags).
450 --
451 -- Returns a list of new packages that may need to be linked in using
452 -- the dynamic linker (see 'linkPackages') as a result of new package
453 -- flags. If you are not doing linking or doing static linking, you
454 -- can ignore the list of packages returned.
455 --
456 setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
457 setSessionDynFlags dflags = do
458 (dflags', preload) <- liftIO $ initPackages dflags
459 modifySession (\h -> h{ hsc_dflags = dflags' })
460 return preload
461
462
463
464 -- %************************************************************************
465 -- %* *
466 -- Setting, getting, and modifying the targets
467 -- %* *
468 -- %************************************************************************
469
470 -- ToDo: think about relative vs. absolute file paths. And what
471 -- happens when the current directory changes.
472
473 -- | Sets the targets for this session. Each target may be a module name
474 -- or a filename. The targets correspond to the set of root modules for
475 -- the program\/library. Unloading the current program is achieved by
476 -- setting the current set of targets to be empty, followed by 'load'.
477 setTargets :: GhcMonad m => [Target] -> m ()
478 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
479
480 -- | Returns the current set of targets
481 getTargets :: GhcMonad m => m [Target]
482 getTargets = withSession (return . hsc_targets)
483
484 -- | Add another target.
485 addTarget :: GhcMonad m => Target -> m ()
486 addTarget target
487 = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
488
489 -- | Remove a target
490 removeTarget :: GhcMonad m => TargetId -> m ()
491 removeTarget target_id
492 = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
493 where
494 filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
495
496 -- | Attempts to guess what Target a string refers to. This function
497 -- implements the @--make@/GHCi command-line syntax for filenames:
498 --
499 -- - if the string looks like a Haskell source filename, then interpret it
500 -- as such
501 --
502 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
503 -- then use that
504 --
505 -- - otherwise interpret the string as a module name
506 --
507 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
508 guessTarget str (Just phase)
509 = return (Target (TargetFile str (Just phase)) True Nothing)
510 guessTarget str Nothing
511 | isHaskellSrcFilename file
512 = return (target (TargetFile file Nothing))
513 | otherwise
514 = do exists <- liftIO $ doesFileExist hs_file
515 if exists
516 then return (target (TargetFile hs_file Nothing))
517 else do
518 exists <- liftIO $ doesFileExist lhs_file
519 if exists
520 then return (target (TargetFile lhs_file Nothing))
521 else do
522 if looksLikeModuleName file
523 then return (target (TargetModule (mkModuleName file)))
524 else do
525 throwGhcException
526 (ProgramError (showSDoc $
527 text "target" <+> quotes (text file) <+>
528 text "is not a module name or a source file"))
529 where
530 (file,obj_allowed)
531 | '*':rest <- str = (rest, False)
532 | otherwise = (str, True)
533
534 hs_file = file <.> "hs"
535 lhs_file = file <.> "lhs"
536
537 target tid = Target tid obj_allowed Nothing
538
539
540 -- | Inform GHC that the working directory has changed. GHC will flush
541 -- its cache of module locations, since it may no longer be valid.
542 --
543 -- Note: Before changing the working directory make sure all threads running
544 -- in the same session have stopped. If you change the working directory,
545 -- you should also unload the current program (set targets to empty,
546 -- followed by load).
547 workingDirectoryChanged :: GhcMonad m => m ()
548 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
549
550
551 -- %************************************************************************
552 -- %* *
553 -- Running phases one at a time
554 -- %* *
555 -- %************************************************************************
556
557 class ParsedMod m where
558 modSummary :: m -> ModSummary
559 parsedSource :: m -> ParsedSource
560
561 class ParsedMod m => TypecheckedMod m where
562 renamedSource :: m -> Maybe RenamedSource
563 typecheckedSource :: m -> TypecheckedSource
564 moduleInfo :: m -> ModuleInfo
565 tm_internals :: m -> (TcGblEnv, ModDetails)
566 -- ToDo: improvements that could be made here:
567 -- if the module succeeded renaming but not typechecking,
568 -- we can still get back the GlobalRdrEnv and exports, so
569 -- perhaps the ModuleInfo should be split up into separate
570 -- fields.
571
572 class TypecheckedMod m => DesugaredMod m where
573 coreModule :: m -> ModGuts
574
575 -- | The result of successful parsing.
576 data ParsedModule =
577 ParsedModule { pm_mod_summary :: ModSummary
578 , pm_parsed_source :: ParsedSource }
579
580 instance ParsedMod ParsedModule where
581 modSummary m = pm_mod_summary m
582 parsedSource m = pm_parsed_source m
583
584 -- | The result of successful typechecking. It also contains the parser
585 -- result.
586 data TypecheckedModule =
587 TypecheckedModule { tm_parsed_module :: ParsedModule
588 , tm_renamed_source :: Maybe RenamedSource
589 , tm_typechecked_source :: TypecheckedSource
590 , tm_checked_module_info :: ModuleInfo
591 , tm_internals_ :: (TcGblEnv, ModDetails)
592 }
593
594 instance ParsedMod TypecheckedModule where
595 modSummary m = modSummary (tm_parsed_module m)
596 parsedSource m = parsedSource (tm_parsed_module m)
597
598 instance TypecheckedMod TypecheckedModule where
599 renamedSource m = tm_renamed_source m
600 typecheckedSource m = tm_typechecked_source m
601 moduleInfo m = tm_checked_module_info m
602 tm_internals m = tm_internals_ m
603
604 -- | The result of successful desugaring (i.e., translation to core). Also
605 -- contains all the information of a typechecked module.
606 data DesugaredModule =
607 DesugaredModule { dm_typechecked_module :: TypecheckedModule
608 , dm_core_module :: ModGuts
609 }
610
611 instance ParsedMod DesugaredModule where
612 modSummary m = modSummary (dm_typechecked_module m)
613 parsedSource m = parsedSource (dm_typechecked_module m)
614
615 instance TypecheckedMod DesugaredModule where
616 renamedSource m = renamedSource (dm_typechecked_module m)
617 typecheckedSource m = typecheckedSource (dm_typechecked_module m)
618 moduleInfo m = moduleInfo (dm_typechecked_module m)
619 tm_internals m = tm_internals_ (dm_typechecked_module m)
620
621 instance DesugaredMod DesugaredModule where
622 coreModule m = dm_core_module m
623
624 type ParsedSource = Located (HsModule RdrName)
625 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
626 Maybe LHsDocString)
627 type TypecheckedSource = LHsBinds Id
628
629 -- NOTE:
630 -- - things that aren't in the output of the typechecker right now:
631 -- - the export list
632 -- - the imports
633 -- - type signatures
634 -- - type/data/newtype declarations
635 -- - class declarations
636 -- - instances
637 -- - extra things in the typechecker's output:
638 -- - default methods are turned into top-level decls.
639 -- - dictionary bindings
640
641 -- | Return the 'ModSummary' of a module with the given name.
642 --
643 -- The module must be part of the module graph (see 'hsc_mod_graph' and
644 -- 'ModuleGraph'). If this is not the case, this function will throw a
645 -- 'GhcApiError'.
646 --
647 -- This function ignores boot modules and requires that there is only one
648 -- non-boot module with the given name.
649 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
650 getModSummary mod = do
651 mg <- liftM hsc_mod_graph getSession
652 case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
653 [] -> throw $ mkApiErr (text "Module not part of module graph")
654 [ms] -> return ms
655 multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
656
657 -- | Parse a module.
658 --
659 -- Throws a 'SourceError' on parse error.
660 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
661 parseModule ms = do
662 hsc_env <- getSession
663 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
664 rdr_module <- liftIO $ hscParse hsc_env_tmp ms
665 return (ParsedModule ms rdr_module)
666
667 -- | Typecheck and rename a parsed module.
668 --
669 -- Throws a 'SourceError' if either fails.
670 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
671 typecheckModule pmod = do
672 let ms = modSummary pmod
673 hsc_env <- getSession
674 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
675 (tc_gbl_env, rn_info)
676 <- liftIO $ hscTypecheckRename hsc_env_tmp ms (parsedSource pmod)
677 details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
678 return $
679 TypecheckedModule {
680 tm_internals_ = (tc_gbl_env, details),
681 tm_parsed_module = pmod,
682 tm_renamed_source = rn_info,
683 tm_typechecked_source = tcg_binds tc_gbl_env,
684 tm_checked_module_info =
685 ModuleInfo {
686 minf_type_env = md_types details,
687 minf_exports = availsToNameSet $ md_exports details,
688 minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
689 minf_instances = md_insts details
690 #ifdef GHCI
691 ,minf_modBreaks = emptyModBreaks
692 #endif
693 }}
694
695 -- | Desugar a typechecked module.
696 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
697 desugarModule tcm = do
698 let ms = modSummary tcm
699 let (tcg, _) = tm_internals tcm
700 hsc_env <- getSession
701 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
702 guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg
703 return $
704 DesugaredModule {
705 dm_typechecked_module = tcm,
706 dm_core_module = guts
707 }
708
709 -- | Load a module. Input doesn't need to be desugared.
710 --
711 -- A module must be loaded before dependent modules can be typechecked. This
712 -- always includes generating a 'ModIface' and, depending on the
713 -- 'DynFlags.hscTarget', may also include code generation.
714 --
715 -- This function will always cause recompilation and will always overwrite
716 -- previous compilation results (potentially files on disk).
717 --
718 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
719 loadModule tcm = do
720 let ms = modSummary tcm
721 let mod = ms_mod_name ms
722 let loc = ms_location ms
723 let (tcg, _details) = tm_internals tcm
724
725 mb_linkable <- case ms_obj_date ms of
726 Just t | t > ms_hs_date ms -> do
727 l <- liftIO $ findObjectLinkable (ms_mod ms)
728 (ml_obj_file loc) t
729 return (Just l)
730 _otherwise -> return Nothing
731
732 -- compile doesn't change the session
733 hsc_env <- getSession
734 mod_info <- liftIO $ compile' (hscNothingBackendOnly tcg,
735 hscInteractiveBackendOnly tcg,
736 hscBatchBackendOnly tcg)
737 hsc_env ms 1 1 Nothing mb_linkable
738
739 modifySession $ \e -> e{ hsc_HPT = addToUFM (hsc_HPT e) mod mod_info }
740 return tcm
741
742
743 -- %************************************************************************
744 -- %* *
745 -- Dealing with Core
746 -- %* *
747 -- %************************************************************************
748
749 -- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
750 -- the 'GHC.compileToCoreModule' interface.
751 data CoreModule
752 = CoreModule {
753 -- | Module name
754 cm_module :: !Module,
755 -- | Type environment for types declared in this module
756 cm_types :: !TypeEnv,
757 -- | Declarations
758 cm_binds :: [CoreBind]
759 }
760
761 instance Outputable CoreModule where
762 ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb}) =
763 text "%module" <+> ppr mn <+> ppr te $$ vcat (map ppr cb)
764
765 -- | This is the way to get access to the Core bindings corresponding
766 -- to a module. 'compileToCore' parses, typechecks, and
767 -- desugars the module, then returns the resulting Core module (consisting of
768 -- the module name, type declarations, and function declarations) if
769 -- successful.
770 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
771 compileToCoreModule = compileCore False
772
773 -- | Like compileToCoreModule, but invokes the simplifier, so
774 -- as to return simplified and tidied Core.
775 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
776 compileToCoreSimplified = compileCore True
777 {-
778 -- | Provided for backwards-compatibility: compileToCore returns just the Core
779 -- bindings, but for most purposes, you probably want to call
780 -- compileToCoreModule.
781 compileToCore :: GhcMonad m => FilePath -> m [CoreBind]
782 compileToCore fn = do
783 mod <- compileToCoreModule session fn
784 return $ cm_binds mod
785 -}
786 -- | Takes a CoreModule and compiles the bindings therein
787 -- to object code. The first argument is a bool flag indicating
788 -- whether to run the simplifier.
789 -- The resulting .o, .hi, and executable files, if any, are stored in the
790 -- current directory, and named according to the module name.
791 -- This has only so far been tested with a single self-contained module.
792 compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
793 compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
794 dflags <- getSessionDynFlags
795 currentTime <- liftIO $ getClockTime
796 cwd <- liftIO $ getCurrentDirectory
797 modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
798 ((moduleNameSlashes . moduleName) mName)
799
800 let modSummary = ModSummary { ms_mod = mName,
801 ms_hsc_src = ExtCoreFile,
802 ms_location = modLocation,
803 -- By setting the object file timestamp to Nothing,
804 -- we always force recompilation, which is what we
805 -- want. (Thus it doesn't matter what the timestamp
806 -- for the (nonexistent) source file is.)
807 ms_hs_date = currentTime,
808 ms_obj_date = Nothing,
809 -- Only handling the single-module case for now, so no imports.
810 ms_srcimps = [],
811 ms_imps = [],
812 -- No source file
813 ms_hspp_file = "",
814 ms_hspp_opts = dflags,
815 ms_hspp_buf = Nothing
816 }
817
818 hsc_env <- getSession
819 liftIO $ hscCompileCore hsc_env simplify modSummary (cm_binds cm)
820
821
822 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
823 compileCore simplify fn = do
824 -- First, set the target to the desired filename
825 target <- guessTarget fn Nothing
826 addTarget target
827 _ <- load LoadAllTargets
828 -- Then find dependencies
829 modGraph <- depanal [] True
830 case find ((== fn) . msHsFilePath) modGraph of
831 Just modSummary -> do
832 -- Now we have the module name;
833 -- parse, typecheck and desugar the module
834 mod_guts <- coreModule `fmap`
835 -- TODO: space leaky: call hsc* directly?
836 (desugarModule =<< typecheckModule =<< parseModule modSummary)
837 liftM gutsToCoreModule $
838 if simplify
839 then do
840 -- If simplify is true: simplify (hscSimplify), then tidy
841 -- (tidyProgram).
842 hsc_env <- getSession
843 simpl_guts <- liftIO $ hscSimplify hsc_env mod_guts
844 tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
845 return $ Left tidy_guts
846 else
847 return $ Right mod_guts
848
849 Nothing -> panic "compileToCoreModule: target FilePath not found in\
850 module dependency graph"
851 where -- two versions, based on whether we simplify (thus run tidyProgram,
852 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
853 -- we just have a ModGuts.
854 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
855 gutsToCoreModule (Left (cg, md)) = CoreModule {
856 cm_module = cg_module cg, cm_types = md_types md,
857 cm_binds = cg_binds cg
858 }
859 gutsToCoreModule (Right mg) = CoreModule {
860 cm_module = mg_module mg, cm_types = mg_types mg,
861 cm_binds = mg_binds mg
862 }
863
864 -- %************************************************************************
865 -- %* *
866 -- Inspecting the session
867 -- %* *
868 -- %************************************************************************
869
870 -- | Get the module dependency graph.
871 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
872 getModuleGraph = liftM hsc_mod_graph getSession
873
874 -- | Determines whether a set of modules requires Template Haskell.
875 --
876 -- Note that if the session's 'DynFlags' enabled Template Haskell when
877 -- 'depanal' was called, then each module in the returned module graph will
878 -- have Template Haskell enabled whether it is actually needed or not.
879 needsTemplateHaskell :: ModuleGraph -> Bool
880 needsTemplateHaskell ms =
881 any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms
882
883 -- | Return @True@ <==> module is loaded.
884 isLoaded :: GhcMonad m => ModuleName -> m Bool
885 isLoaded m = withSession $ \hsc_env ->
886 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
887
888 -- | Return the bindings for the current interactive session.
889 getBindings :: GhcMonad m => m [TyThing]
890 getBindings = withSession $ \hsc_env ->
891 -- we have to implement the shadowing behaviour of ic_tmp_ids here
892 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
893 let
894 occ_env = mkOccEnv [ (nameOccName (idName id), AnId id)
895 | id <- ic_tmp_ids (hsc_IC hsc_env) ]
896 in
897 return (occEnvElts occ_env)
898
899 getPrintUnqual :: GhcMonad m => m PrintUnqualified
900 getPrintUnqual = withSession $ \hsc_env ->
901 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
902
903 -- | Container for information about a 'Module'.
904 data ModuleInfo = ModuleInfo {
905 minf_type_env :: TypeEnv,
906 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
907 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
908 minf_instances :: [Instance]
909 #ifdef GHCI
910 ,minf_modBreaks :: ModBreaks
911 #endif
912 -- ToDo: this should really contain the ModIface too
913 }
914 -- We don't want HomeModInfo here, because a ModuleInfo applies
915 -- to package modules too.
916
917 -- | Request information about a loaded 'Module'
918 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
919 getModuleInfo mdl = withSession $ \hsc_env -> do
920 let mg = hsc_mod_graph hsc_env
921 if mdl `elem` map ms_mod mg
922 then liftIO $ getHomeModuleInfo hsc_env (moduleName mdl)
923 else do
924 {- if isHomeModule (hsc_dflags hsc_env) mdl
925 then return Nothing
926 else -} liftIO $ getPackageModuleInfo hsc_env mdl
927 -- getPackageModuleInfo will attempt to find the interface, so
928 -- we don't want to call it for a home module, just in case there
929 -- was a problem loading the module and the interface doesn't
930 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
931
932 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
933 #ifdef GHCI
934 getPackageModuleInfo hsc_env mdl = do
935 mb_avails <- hscGetModuleExports hsc_env mdl
936 -- This is the only use of hscGetModuleExports. Perhaps we could use
937 -- hscRnImportDecls instead, but that does a lot more than we need
938 -- (building instance environment, checking family instance consistency
939 -- etc.).
940 case mb_avails of
941 Nothing -> return Nothing
942 Just avails -> do
943 eps <- readIORef (hsc_EPS hsc_env)
944 let
945 names = availsToNameSet avails
946 pte = eps_PTE eps
947 tys = [ ty | name <- concatMap availNames avails,
948 Just ty <- [lookupTypeEnv pte name] ]
949 --
950 return (Just (ModuleInfo {
951 minf_type_env = mkTypeEnv tys,
952 minf_exports = names,
953 minf_rdr_env = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
954 minf_instances = error "getModuleInfo: instances for package module unimplemented",
955 minf_modBreaks = emptyModBreaks
956 }))
957 #else
958 getPackageModuleInfo _hsc_env _mdl = do
959 -- bogusly different for non-GHCI (ToDo)
960 return Nothing
961 #endif
962
963 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
964 getHomeModuleInfo hsc_env mdl =
965 case lookupUFM (hsc_HPT hsc_env) mdl of
966 Nothing -> return Nothing
967 Just hmi -> do
968 let details = hm_details hmi
969 return (Just (ModuleInfo {
970 minf_type_env = md_types details,
971 minf_exports = availsToNameSet (md_exports details),
972 minf_rdr_env = mi_globals $! hm_iface hmi,
973 minf_instances = md_insts details
974 #ifdef GHCI
975 ,minf_modBreaks = getModBreaks hmi
976 #endif
977 }))
978
979 -- | The list of top-level entities defined in a module
980 modInfoTyThings :: ModuleInfo -> [TyThing]
981 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
982
983 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
984 modInfoTopLevelScope minf
985 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
986
987 modInfoExports :: ModuleInfo -> [Name]
988 modInfoExports minf = nameSetToList $! minf_exports minf
989
990 -- | Returns the instances defined by the specified module.
991 -- Warning: currently unimplemented for package modules.
992 modInfoInstances :: ModuleInfo -> [Instance]
993 modInfoInstances = minf_instances
994
995 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
996 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
997
998 mkPrintUnqualifiedForModule :: GhcMonad m =>
999 ModuleInfo
1000 -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
1001 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
1002 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
1003
1004 modInfoLookupName :: GhcMonad m =>
1005 ModuleInfo -> Name
1006 -> m (Maybe TyThing) -- XXX: returns a Maybe X
1007 modInfoLookupName minf name = withSession $ \hsc_env -> do
1008 case lookupTypeEnv (minf_type_env minf) name of
1009 Just tyThing -> return (Just tyThing)
1010 Nothing -> do
1011 eps <- liftIO $ readIORef (hsc_EPS hsc_env)
1012 return $! lookupType (hsc_dflags hsc_env)
1013 (hsc_HPT hsc_env) (eps_PTE eps) name
1014
1015 #ifdef GHCI
1016 modInfoModBreaks :: ModuleInfo -> ModBreaks
1017 modInfoModBreaks = minf_modBreaks
1018 #endif
1019
1020 isDictonaryId :: Id -> Bool
1021 isDictonaryId id
1022 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
1023
1024 -- | Looks up a global name: that is, any top-level name in any
1025 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
1026 -- the interactive context, and therefore does not require a preceding
1027 -- 'setContext'.
1028 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
1029 lookupGlobalName name = withSession $ \hsc_env -> do
1030 liftIO $ lookupTypeHscEnv hsc_env name
1031
1032 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
1033 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
1034 ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
1035 return (findAnns deserialize ann_env target)
1036
1037 #ifdef GHCI
1038 -- | get the GlobalRdrEnv for a session
1039 getGRE :: GhcMonad m => m GlobalRdrEnv
1040 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
1041 #endif
1042
1043 -- -----------------------------------------------------------------------------
1044
1045 -- | Return all /external/ modules available in the package database.
1046 -- Modules from the current session (i.e., from the 'HomePackageTable') are
1047 -- not included.
1048 packageDbModules :: GhcMonad m =>
1049 Bool -- ^ Only consider exposed packages.
1050 -> m [Module]
1051 packageDbModules only_exposed = do
1052 dflags <- getSessionDynFlags
1053 let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
1054 return $
1055 [ mkModule pid modname | p <- pkgs
1056 , not only_exposed || exposed p
1057 , let pid = packageConfigId p
1058 , modname <- exposedModules p ]
1059
1060 -- -----------------------------------------------------------------------------
1061 -- Misc exported utils
1062
1063 dataConType :: DataCon -> Type
1064 dataConType dc = idType (dataConWrapId dc)
1065
1066 -- | print a 'NamedThing', adding parentheses if the name is an operator.
1067 pprParenSymName :: NamedThing a => a -> SDoc
1068 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
1069
1070 -- ----------------------------------------------------------------------------
1071
1072 #if 0
1073
1074 -- ToDo:
1075 -- - Data and Typeable instances for HsSyn.
1076
1077 -- ToDo: check for small transformations that happen to the syntax in
1078 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1079
1080 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
1081 -- to get from TyCons, Ids etc. to TH syntax (reify).
1082
1083 -- :browse will use either lm_toplev or inspect lm_interface, depending
1084 -- on whether the module is interpreted or not.
1085
1086 #endif
1087
1088 -- Extract the filename, stringbuffer content and dynflags associed to a module
1089 --
1090 -- XXX: Explain pre-conditions
1091 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
1092 getModuleSourceAndFlags mod = do
1093 m <- getModSummary (moduleName mod)
1094 case ml_hs_file $ ms_location m of
1095 Nothing -> throw $ mkApiErr (text "No source available for module " <+> ppr mod)
1096 Just sourceFile -> do
1097 source <- liftIO $ hGetStringBuffer sourceFile
1098 return (sourceFile, source, ms_hspp_opts m)
1099
1100
1101 -- | Return module source as token stream, including comments.
1102 --
1103 -- The module must be in the module graph and its source must be available.
1104 -- Throws a 'HscTypes.SourceError' on parse error.
1105 getTokenStream :: GhcMonad m => Module -> m [Located Token]
1106 getTokenStream mod = do
1107 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1108 let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
1109 case lexTokenStream source startLoc flags of
1110 POk _ ts -> return ts
1111 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
1112
1113 -- | Give even more information on the source than 'getTokenStream'
1114 -- This function allows reconstructing the source completely with
1115 -- 'showRichTokenStream'.
1116 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
1117 getRichTokenStream mod = do
1118 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1119 let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
1120 case lexTokenStream source startLoc flags of
1121 POk _ ts -> return $ addSourceToTokens startLoc source ts
1122 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
1123
1124 -- | Given a source location and a StringBuffer corresponding to this
1125 -- location, return a rich token stream with the source associated to the
1126 -- tokens.
1127 addSourceToTokens :: RealSrcLoc -> StringBuffer -> [Located Token]
1128 -> [(Located Token, String)]
1129 addSourceToTokens _ _ [] = []
1130 addSourceToTokens loc buf (t@(L span _) : ts)
1131 = case span of
1132 UnhelpfulSpan _ -> (t,"") : addSourceToTokens loc buf ts
1133 RealSrcSpan s -> (t,str) : addSourceToTokens newLoc newBuf ts
1134 where
1135 (newLoc, newBuf, str) = go "" loc buf
1136 start = realSrcSpanStart s
1137 end = realSrcSpanEnd s
1138 go acc loc buf | loc < start = go acc nLoc nBuf
1139 | start <= loc && loc < end = go (ch:acc) nLoc nBuf
1140 | otherwise = (loc, buf, reverse acc)
1141 where (ch, nBuf) = nextChar buf
1142 nLoc = advanceSrcLoc loc ch
1143
1144
1145 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
1146 -- return source code almost identical to the original code (except for
1147 -- insignificant whitespace.)
1148 showRichTokenStream :: [(Located Token, String)] -> String
1149 showRichTokenStream ts = go startLoc ts ""
1150 where sourceFile = getFile $ map (getLoc . fst) ts
1151 getFile [] = panic "showRichTokenStream: No source file found"
1152 getFile (UnhelpfulSpan _ : xs) = getFile xs
1153 getFile (RealSrcSpan s : _) = srcSpanFile s
1154 startLoc = mkRealSrcLoc sourceFile 1 1
1155 go _ [] = id
1156 go loc ((L span _, str):ts)
1157 = case span of
1158 UnhelpfulSpan _ -> go loc ts
1159 RealSrcSpan s
1160 | locLine == tokLine -> ((replicate (tokCol - locCol) ' ') ++)
1161 . (str ++)
1162 . go tokEnd ts
1163 | otherwise -> ((replicate (tokLine - locLine) '\n') ++)
1164 . ((replicate tokCol ' ') ++)
1165 . (str ++)
1166 . go tokEnd ts
1167 where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
1168 (tokLine, tokCol) = (srcSpanStartLine s, srcSpanStartCol s)
1169 tokEnd = realSrcSpanEnd s
1170
1171 -- -----------------------------------------------------------------------------
1172 -- Interactive evaluation
1173
1174 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
1175 -- filesystem and package database to find the corresponding 'Module',
1176 -- using the algorithm that is used for an @import@ declaration.
1177 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1178 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
1179 let
1180 dflags = hsc_dflags hsc_env
1181 this_pkg = thisPackage dflags
1182 --
1183 case maybe_pkg of
1184 Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
1185 res <- findImportedModule hsc_env mod_name maybe_pkg
1186 case res of
1187 Found _ m -> return m
1188 err -> noModError dflags noSrcSpan mod_name err
1189 _otherwise -> do
1190 home <- lookupLoadedHomeModule mod_name
1191 case home of
1192 Just m -> return m
1193 Nothing -> liftIO $ do
1194 res <- findImportedModule hsc_env mod_name maybe_pkg
1195 case res of
1196 Found loc m | modulePackageId m /= this_pkg -> return m
1197 | otherwise -> modNotLoadedError m loc
1198 err -> noModError dflags noSrcSpan mod_name err
1199
1200 modNotLoadedError :: Module -> ModLocation -> IO a
1201 modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $
1202 text "module is not loaded:" <+>
1203 quotes (ppr (moduleName m)) <+>
1204 parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
1205
1206 -- | Like 'findModule', but differs slightly when the module refers to
1207 -- a source file, and the file has not been loaded via 'load'. In
1208 -- this case, 'findModule' will throw an error (module not loaded),
1209 -- but 'lookupModule' will check to see whether the module can also be
1210 -- found in a package, and if so, that package 'Module' will be
1211 -- returned. If not, the usual module-not-found error will be thrown.
1212 --
1213 lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1214 lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
1215 lookupModule mod_name Nothing = withSession $ \hsc_env -> do
1216 home <- lookupLoadedHomeModule mod_name
1217 case home of
1218 Just m -> return m
1219 Nothing -> liftIO $ do
1220 res <- findExposedPackageModule hsc_env mod_name Nothing
1221 case res of
1222 Found _ m -> return m
1223 err -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
1224
1225 lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
1226 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
1227 case lookupUFM (hsc_HPT hsc_env) mod_name of
1228 Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
1229 _not_a_home_module -> return Nothing
1230
1231 #ifdef GHCI
1232 getHistorySpan :: GhcMonad m => History -> m SrcSpan
1233 getHistorySpan h = withSession $ \hsc_env ->
1234 return$ InteractiveEval.getHistorySpan hsc_env h
1235
1236 obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term
1237 obtainTermFromVal bound force ty a =
1238 withSession $ \hsc_env ->
1239 liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
1240
1241 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
1242 obtainTermFromId bound force id =
1243 withSession $ \hsc_env ->
1244 liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
1245
1246 #endif
1247
1248 -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
1249 -- entity known to GHC, including 'Name's defined using 'runStmt'.
1250 lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
1251 lookupName name =
1252 withSession $ \hsc_env ->
1253 liftIO $ hscTcRcLookupName hsc_env name
1254
1255 -- -----------------------------------------------------------------------------
1256 -- Pure API
1257
1258 -- | A pure interface to the module parser.
1259 --
1260 parser :: String -- ^ Haskell module source text (full Unicode is supported)
1261 -> DynFlags -- ^ the flags
1262 -> FilePath -- ^ the filename (for source locations)
1263 -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
1264
1265 parser str dflags filename =
1266 let
1267 loc = mkRealSrcLoc (mkFastString filename) 1 1
1268 buf = stringToStringBuffer str
1269 in
1270 case unP Parser.parseModule (mkPState dflags buf loc) of
1271
1272 PFailed span err ->
1273 Left (unitBag (mkPlainErrMsg span err))
1274
1275 POk pst rdr_module ->
1276 let (warns,_) = getMessages pst in
1277 Right (warns, rdr_module)