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