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