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