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