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