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