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