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