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