Rename package key to unit ID, and installed package ID to component ID.
[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 UnitId,
159
160 -- ** Modules
161 Module, mkModule, pprModule, moduleName, moduleUnitId,
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 Signal _ -> exitWith (ExitFailure 1)
402 _ -> do fatalErrorMsg'' fm (show ge)
403 exitWith (ExitFailure 1)
404 ) $
405 inner
406
407 -- | Install a default cleanup handler to remove temporary files deposited by
408 -- a GHC run. This is separate from 'defaultErrorHandler', because you might
409 -- want to override the error handling, but still get the ordinary cleanup
410 -- behaviour.
411 defaultCleanupHandler :: (ExceptionMonad m) =>
412 DynFlags -> m a -> m a
413 defaultCleanupHandler dflags inner =
414 -- make sure we clean up after ourselves
415 inner `gfinally`
416 (liftIO $ do
417 cleanTempFiles dflags
418 cleanTempDirs dflags
419 )
420 -- exceptions will be blocked while we clean the temporary files,
421 -- so there shouldn't be any difficulty if we receive further
422 -- signals.
423
424
425 -- %************************************************************************
426 -- %* *
427 -- The Ghc Monad
428 -- %* *
429 -- %************************************************************************
430
431 -- | Run function for the 'Ghc' monad.
432 --
433 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
434 -- to this function will create a new session which should not be shared among
435 -- several threads.
436 --
437 -- Any errors not handled inside the 'Ghc' action are propagated as IO
438 -- exceptions.
439
440 runGhc :: Maybe FilePath -- ^ See argument to 'initGhcMonad'.
441 -> Ghc a -- ^ The action to perform.
442 -> IO a
443 runGhc mb_top_dir ghc = do
444 ref <- newIORef (panic "empty session")
445 let session = Session ref
446 flip unGhc session $ do
447 initGhcMonad mb_top_dir
448 ghc
449 -- XXX: unregister interrupt handlers here?
450
451 -- | Run function for 'GhcT' monad transformer.
452 --
453 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
454 -- to this function will create a new session which should not be shared among
455 -- several threads.
456
457 #if __GLASGOW_HASKELL__ < 710
458 -- Pre-AMP change
459 runGhcT :: (ExceptionMonad m, Functor m) =>
460 #else
461 runGhcT :: (ExceptionMonad m) =>
462 #endif
463 Maybe FilePath -- ^ See argument to 'initGhcMonad'.
464 -> GhcT m a -- ^ The action to perform.
465 -> m a
466 runGhcT mb_top_dir ghct = do
467 ref <- liftIO $ newIORef (panic "empty session")
468 let session = Session ref
469 flip unGhcT session $ do
470 initGhcMonad mb_top_dir
471 ghct
472
473 -- | Initialise a GHC session.
474 --
475 -- If you implement a custom 'GhcMonad' you must call this function in the
476 -- monad run function. It will initialise the session variable and clear all
477 -- warnings.
478 --
479 -- The first argument should point to the directory where GHC's library files
480 -- reside. More precisely, this should be the output of @ghc --print-libdir@
481 -- of the version of GHC the module using this API is compiled with. For
482 -- portability, you should use the @ghc-paths@ package, available at
483 -- <http://hackage.haskell.org/package/ghc-paths>.
484
485 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
486 initGhcMonad mb_top_dir
487 = do { env <- liftIO $
488 do { installSignalHandlers -- catch ^C
489 ; initStaticOpts
490 ; mySettings <- initSysTools mb_top_dir
491 ; dflags <- initDynFlags (defaultDynFlags mySettings)
492 ; checkBrokenTablesNextToCode dflags
493 ; setUnsafeGlobalDynFlags dflags
494 -- c.f. DynFlags.parseDynamicFlagsFull, which
495 -- creates DynFlags and sets the UnsafeGlobalDynFlags
496 ; newHscEnv dflags }
497 ; setSession env }
498
499 -- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which
500 -- breaks tables-next-to-code in dynamically linked modules. This
501 -- check should be more selective but there is currently no released
502 -- version where this bug is fixed.
503 -- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and
504 -- https://ghc.haskell.org/trac/ghc/ticket/4210#comment:29
505 checkBrokenTablesNextToCode :: MonadIO m => DynFlags -> m ()
506 checkBrokenTablesNextToCode dflags
507 = do { broken <- checkBrokenTablesNextToCode' dflags
508 ; when broken
509 $ do { _ <- liftIO $ throwIO $ mkApiErr dflags invalidLdErr
510 ; fail "unsupported linker"
511 }
512 }
513 where
514 invalidLdErr = text "Tables-next-to-code not supported on ARM" <+>
515 text "when using binutils ld (please see:" <+>
516 text "https://sourceware.org/bugzilla/show_bug.cgi?id=16177)"
517
518 checkBrokenTablesNextToCode' :: MonadIO m => DynFlags -> m Bool
519 checkBrokenTablesNextToCode' dflags
520 | not (isARM arch) = return False
521 | WayDyn `notElem` ways dflags = return False
522 | not (tablesNextToCode dflags) = return False
523 | otherwise = do
524 linkerInfo <- liftIO $ getLinkerInfo dflags
525 case linkerInfo of
526 GnuLD _ -> return True
527 _ -> return False
528 where platform = targetPlatform dflags
529 arch = platformArch platform
530
531
532 -- %************************************************************************
533 -- %* *
534 -- Flags & settings
535 -- %* *
536 -- %************************************************************************
537
538 -- $DynFlags
539 --
540 -- The GHC session maintains two sets of 'DynFlags':
541 --
542 -- * The "interactive" @DynFlags@, which are used for everything
543 -- related to interactive evaluation, including 'runStmt',
544 -- 'runDecls', 'exprType', 'lookupName' and so on (everything
545 -- under \"Interactive evaluation\" in this module).
546 --
547 -- * The "program" @DynFlags@, which are used when loading
548 -- whole modules with 'load'
549 --
550 -- 'setInteractiveDynFlags', 'getInteractiveDynFlags' work with the
551 -- interactive @DynFlags@.
552 --
553 -- 'setProgramDynFlags', 'getProgramDynFlags' work with the
554 -- program @DynFlags@.
555 --
556 -- 'setSessionDynFlags' sets both @DynFlags@, and 'getSessionDynFlags'
557 -- retrieves the program @DynFlags@ (for backwards compatibility).
558
559
560 -- | Updates both the interactive and program DynFlags in a Session.
561 -- This also reads the package database (unless it has already been
562 -- read), and prepares the compilers knowledge about packages. It can
563 -- be called again to load new packages: just add new package flags to
564 -- (packageFlags dflags).
565 --
566 -- Returns a list of new packages that may need to be linked in using
567 -- the dynamic linker (see 'linkPackages') as a result of new package
568 -- flags. If you are not doing linking or doing static linking, you
569 -- can ignore the list of packages returned.
570 --
571 setSessionDynFlags :: GhcMonad m => DynFlags -> m [UnitId]
572 setSessionDynFlags dflags = do
573 dflags' <- checkNewDynFlags dflags
574 (dflags'', preload) <- liftIO $ initPackages dflags'
575 modifySession $ \h -> h{ hsc_dflags = dflags''
576 , hsc_IC = (hsc_IC h){ ic_dflags = dflags'' } }
577 invalidateModSummaryCache
578 return preload
579
580 -- | Sets the program 'DynFlags'.
581 setProgramDynFlags :: GhcMonad m => DynFlags -> m [UnitId]
582 setProgramDynFlags dflags = do
583 dflags' <- checkNewDynFlags dflags
584 (dflags'', preload) <- liftIO $ initPackages dflags'
585 modifySession $ \h -> h{ hsc_dflags = dflags'' }
586 invalidateModSummaryCache
587 return preload
588
589 -- When changing the DynFlags, we want the changes to apply to future
590 -- loads, but without completely discarding the program. But the
591 -- DynFlags are cached in each ModSummary in the hsc_mod_graph, so
592 -- after a change to DynFlags, the changes would apply to new modules
593 -- but not existing modules; this seems undesirable.
594 --
595 -- Furthermore, the GHC API client might expect that changing
596 -- log_action would affect future compilation messages, but for those
597 -- modules we have cached ModSummaries for, we'll continue to use the
598 -- old log_action. This is definitely wrong (#7478).
599 --
600 -- Hence, we invalidate the ModSummary cache after changing the
601 -- DynFlags. We do this by tweaking the date on each ModSummary, so
602 -- that the next downsweep will think that all the files have changed
603 -- and preprocess them again. This won't necessarily cause everything
604 -- to be recompiled, because by the time we check whether we need to
605 -- recopmile a module, we'll have re-summarised the module and have a
606 -- correct ModSummary.
607 --
608 invalidateModSummaryCache :: GhcMonad m => m ()
609 invalidateModSummaryCache =
610 modifySession $ \h -> h { hsc_mod_graph = map inval (hsc_mod_graph h) }
611 where
612 inval ms = ms { ms_hs_date = addUTCTime (-1) (ms_hs_date ms) }
613
614 -- | Returns the program 'DynFlags'.
615 getProgramDynFlags :: GhcMonad m => m DynFlags
616 getProgramDynFlags = getSessionDynFlags
617
618 -- | Set the 'DynFlags' used to evaluate interactive expressions.
619 -- Note: this cannot be used for changes to packages. Use
620 -- 'setSessionDynFlags', or 'setProgramDynFlags' and then copy the
621 -- 'pkgState' into the interactive @DynFlags@.
622 setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
623 setInteractiveDynFlags dflags = do
624 dflags' <- checkNewDynFlags dflags
625 modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags' }}
626
627 -- | Get the 'DynFlags' used to evaluate interactive expressions.
628 getInteractiveDynFlags :: GhcMonad m => m DynFlags
629 getInteractiveDynFlags = withSession $ \h -> return (ic_dflags (hsc_IC h))
630
631
632 parseDynamicFlags :: MonadIO m =>
633 DynFlags -> [Located String]
634 -> m (DynFlags, [Located String], [Located String])
635 parseDynamicFlags = parseDynamicFlagsCmdLine
636
637 -- | Checks the set of new DynFlags for possibly erroneous option
638 -- combinations when invoking 'setSessionDynFlags' and friends, and if
639 -- found, returns a fixed copy (if possible).
640 checkNewDynFlags :: MonadIO m => DynFlags -> m DynFlags
641 checkNewDynFlags dflags = do
642 -- See Note [DynFlags consistency]
643 let (dflags', warnings) = makeDynFlagsConsistent dflags
644 liftIO $ handleFlagWarnings dflags warnings
645 return dflags'
646
647 -- %************************************************************************
648 -- %* *
649 -- Setting, getting, and modifying the targets
650 -- %* *
651 -- %************************************************************************
652
653 -- ToDo: think about relative vs. absolute file paths. And what
654 -- happens when the current directory changes.
655
656 -- | Sets the targets for this session. Each target may be a module name
657 -- or a filename. The targets correspond to the set of root modules for
658 -- the program\/library. Unloading the current program is achieved by
659 -- setting the current set of targets to be empty, followed by 'load'.
660 setTargets :: GhcMonad m => [Target] -> m ()
661 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
662
663 -- | Returns the current set of targets
664 getTargets :: GhcMonad m => m [Target]
665 getTargets = withSession (return . hsc_targets)
666
667 -- | Add another target.
668 addTarget :: GhcMonad m => Target -> m ()
669 addTarget target
670 = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
671
672 -- | Remove a target
673 removeTarget :: GhcMonad m => TargetId -> m ()
674 removeTarget target_id
675 = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
676 where
677 filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
678
679 -- | Attempts to guess what Target a string refers to. This function
680 -- implements the @--make@/GHCi command-line syntax for filenames:
681 --
682 -- - if the string looks like a Haskell source filename, then interpret it
683 -- as such
684 --
685 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
686 -- then use that
687 --
688 -- - otherwise interpret the string as a module name
689 --
690 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
691 guessTarget str (Just phase)
692 = return (Target (TargetFile str (Just phase)) True Nothing)
693 guessTarget str Nothing
694 | isHaskellSrcFilename file
695 = return (target (TargetFile file Nothing))
696 | otherwise
697 = do exists <- liftIO $ doesFileExist hs_file
698 if exists
699 then return (target (TargetFile hs_file Nothing))
700 else do
701 exists <- liftIO $ doesFileExist lhs_file
702 if exists
703 then return (target (TargetFile lhs_file Nothing))
704 else do
705 if looksLikeModuleName file
706 then return (target (TargetModule (mkModuleName file)))
707 else do
708 dflags <- getDynFlags
709 liftIO $ throwGhcExceptionIO
710 (ProgramError (showSDoc dflags $
711 text "target" <+> quotes (text file) <+>
712 text "is not a module name or a source file"))
713 where
714 (file,obj_allowed)
715 | '*':rest <- str = (rest, False)
716 | otherwise = (str, True)
717
718 hs_file = file <.> "hs"
719 lhs_file = file <.> "lhs"
720
721 target tid = Target tid obj_allowed Nothing
722
723
724 -- | Inform GHC that the working directory has changed. GHC will flush
725 -- its cache of module locations, since it may no longer be valid.
726 --
727 -- Note: Before changing the working directory make sure all threads running
728 -- in the same session have stopped. If you change the working directory,
729 -- you should also unload the current program (set targets to empty,
730 -- followed by load).
731 workingDirectoryChanged :: GhcMonad m => m ()
732 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
733
734
735 -- %************************************************************************
736 -- %* *
737 -- Running phases one at a time
738 -- %* *
739 -- %************************************************************************
740
741 class ParsedMod m where
742 modSummary :: m -> ModSummary
743 parsedSource :: m -> ParsedSource
744
745 class ParsedMod m => TypecheckedMod m where
746 renamedSource :: m -> Maybe RenamedSource
747 typecheckedSource :: m -> TypecheckedSource
748 moduleInfo :: m -> ModuleInfo
749 tm_internals :: m -> (TcGblEnv, ModDetails)
750 -- ToDo: improvements that could be made here:
751 -- if the module succeeded renaming but not typechecking,
752 -- we can still get back the GlobalRdrEnv and exports, so
753 -- perhaps the ModuleInfo should be split up into separate
754 -- fields.
755
756 class TypecheckedMod m => DesugaredMod m where
757 coreModule :: m -> ModGuts
758
759 -- | The result of successful parsing.
760 data ParsedModule =
761 ParsedModule { pm_mod_summary :: ModSummary
762 , pm_parsed_source :: ParsedSource
763 , pm_extra_src_files :: [FilePath]
764 , pm_annotations :: ApiAnns }
765 -- See Note [Api annotations] in ApiAnnotation.hs
766
767 instance ParsedMod ParsedModule where
768 modSummary m = pm_mod_summary m
769 parsedSource m = pm_parsed_source m
770
771 -- | The result of successful typechecking. It also contains the parser
772 -- result.
773 data TypecheckedModule =
774 TypecheckedModule { tm_parsed_module :: ParsedModule
775 , tm_renamed_source :: Maybe RenamedSource
776 , tm_typechecked_source :: TypecheckedSource
777 , tm_checked_module_info :: ModuleInfo
778 , tm_internals_ :: (TcGblEnv, ModDetails)
779 }
780
781 instance ParsedMod TypecheckedModule where
782 modSummary m = modSummary (tm_parsed_module m)
783 parsedSource m = parsedSource (tm_parsed_module m)
784
785 instance TypecheckedMod TypecheckedModule where
786 renamedSource m = tm_renamed_source m
787 typecheckedSource m = tm_typechecked_source m
788 moduleInfo m = tm_checked_module_info m
789 tm_internals m = tm_internals_ m
790
791 -- | The result of successful desugaring (i.e., translation to core). Also
792 -- contains all the information of a typechecked module.
793 data DesugaredModule =
794 DesugaredModule { dm_typechecked_module :: TypecheckedModule
795 , dm_core_module :: ModGuts
796 }
797
798 instance ParsedMod DesugaredModule where
799 modSummary m = modSummary (dm_typechecked_module m)
800 parsedSource m = parsedSource (dm_typechecked_module m)
801
802 instance TypecheckedMod DesugaredModule where
803 renamedSource m = renamedSource (dm_typechecked_module m)
804 typecheckedSource m = typecheckedSource (dm_typechecked_module m)
805 moduleInfo m = moduleInfo (dm_typechecked_module m)
806 tm_internals m = tm_internals_ (dm_typechecked_module m)
807
808 instance DesugaredMod DesugaredModule where
809 coreModule m = dm_core_module m
810
811 type ParsedSource = Located (HsModule RdrName)
812 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
813 Maybe LHsDocString)
814 type TypecheckedSource = LHsBinds Id
815
816 -- NOTE:
817 -- - things that aren't in the output of the typechecker right now:
818 -- - the export list
819 -- - the imports
820 -- - type signatures
821 -- - type/data/newtype declarations
822 -- - class declarations
823 -- - instances
824 -- - extra things in the typechecker's output:
825 -- - default methods are turned into top-level decls.
826 -- - dictionary bindings
827
828 -- | Return the 'ModSummary' of a module with the given name.
829 --
830 -- The module must be part of the module graph (see 'hsc_mod_graph' and
831 -- 'ModuleGraph'). If this is not the case, this function will throw a
832 -- 'GhcApiError'.
833 --
834 -- This function ignores boot modules and requires that there is only one
835 -- non-boot module with the given name.
836 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
837 getModSummary mod = do
838 mg <- liftM hsc_mod_graph getSession
839 case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
840 [] -> do dflags <- getDynFlags
841 liftIO $ throwIO $ mkApiErr dflags (text "Module not part of module graph")
842 [ms] -> return ms
843 multiple -> do dflags <- getDynFlags
844 liftIO $ throwIO $ mkApiErr dflags (text "getModSummary is ambiguous: " <+> ppr multiple)
845
846 -- | Parse a module.
847 --
848 -- Throws a 'SourceError' on parse error.
849 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
850 parseModule ms = do
851 hsc_env <- getSession
852 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
853 hpm <- liftIO $ hscParse hsc_env_tmp ms
854 return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm)
855 (hpm_annotations hpm))
856 -- See Note [Api annotations] in ApiAnnotation.hs
857
858 -- | Typecheck and rename a parsed module.
859 --
860 -- Throws a 'SourceError' if either fails.
861 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
862 typecheckModule pmod = do
863 let ms = modSummary pmod
864 hsc_env <- getSession
865 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
866 (tc_gbl_env, rn_info)
867 <- liftIO $ hscTypecheckRename hsc_env_tmp ms $
868 HsParsedModule { hpm_module = parsedSource pmod,
869 hpm_src_files = pm_extra_src_files pmod,
870 hpm_annotations = pm_annotations pmod }
871 details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
872 safe <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env
873
874 return $
875 TypecheckedModule {
876 tm_internals_ = (tc_gbl_env, details),
877 tm_parsed_module = pmod,
878 tm_renamed_source = rn_info,
879 tm_typechecked_source = tcg_binds tc_gbl_env,
880 tm_checked_module_info =
881 ModuleInfo {
882 minf_type_env = md_types details,
883 minf_exports = availsToNameSet $ md_exports details,
884 minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
885 minf_instances = fixSafeInstances safe $ md_insts details,
886 minf_iface = Nothing,
887 minf_safe = safe
888 #ifdef GHCI
889 ,minf_modBreaks = emptyModBreaks
890 #endif
891 }}
892
893 -- | Desugar a typechecked module.
894 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
895 desugarModule tcm = do
896 let ms = modSummary tcm
897 let (tcg, _) = tm_internals tcm
898 hsc_env <- getSession
899 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
900 guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg
901 return $
902 DesugaredModule {
903 dm_typechecked_module = tcm,
904 dm_core_module = guts
905 }
906
907 -- | Load a module. Input doesn't need to be desugared.
908 --
909 -- A module must be loaded before dependent modules can be typechecked. This
910 -- always includes generating a 'ModIface' and, depending on the
911 -- 'DynFlags.hscTarget', may also include code generation.
912 --
913 -- This function will always cause recompilation and will always overwrite
914 -- previous compilation results (potentially files on disk).
915 --
916 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
917 loadModule tcm = do
918 let ms = modSummary tcm
919 let mod = ms_mod_name ms
920 let loc = ms_location ms
921 let (tcg, _details) = tm_internals tcm
922
923 mb_linkable <- case ms_obj_date ms of
924 Just t | t > ms_hs_date ms -> do
925 l <- liftIO $ findObjectLinkable (ms_mod ms)
926 (ml_obj_file loc) t
927 return (Just l)
928 _otherwise -> return Nothing
929
930 let source_modified | isNothing mb_linkable = SourceModified
931 | otherwise = SourceUnmodified
932 -- we can't determine stability here
933
934 -- compile doesn't change the session
935 hsc_env <- getSession
936 mod_info <- liftIO $ compileOne' (Just tcg) Nothing
937 hsc_env ms 1 1 Nothing mb_linkable
938 source_modified
939
940 modifySession $ \e -> e{ hsc_HPT = addToUFM (hsc_HPT e) mod mod_info }
941 return tcm
942
943
944 -- %************************************************************************
945 -- %* *
946 -- Dealing with Core
947 -- %* *
948 -- %************************************************************************
949
950 -- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
951 -- the 'GHC.compileToCoreModule' interface.
952 data CoreModule
953 = CoreModule {
954 -- | Module name
955 cm_module :: !Module,
956 -- | Type environment for types declared in this module
957 cm_types :: !TypeEnv,
958 -- | Declarations
959 cm_binds :: CoreProgram,
960 -- | Safe Haskell mode
961 cm_safe :: SafeHaskellMode
962 }
963
964 instance Outputable CoreModule where
965 ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb,
966 cm_safe = sf})
967 = text "%module" <+> ppr mn <+> parens (ppr sf) <+> ppr te
968 $$ vcat (map ppr cb)
969
970 -- | This is the way to get access to the Core bindings corresponding
971 -- to a module. 'compileToCore' parses, typechecks, and
972 -- desugars the module, then returns the resulting Core module (consisting of
973 -- the module name, type declarations, and function declarations) if
974 -- successful.
975 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
976 compileToCoreModule = compileCore False
977
978 -- | Like compileToCoreModule, but invokes the simplifier, so
979 -- as to return simplified and tidied Core.
980 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
981 compileToCoreSimplified = compileCore True
982
983 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
984 compileCore simplify fn = do
985 -- First, set the target to the desired filename
986 target <- guessTarget fn Nothing
987 addTarget target
988 _ <- load LoadAllTargets
989 -- Then find dependencies
990 modGraph <- depanal [] True
991 case find ((== Just fn) . msHsFilePath) modGraph of
992 Just modSummary -> do
993 -- Now we have the module name;
994 -- parse, typecheck and desugar the module
995 mod_guts <- coreModule `fmap`
996 -- TODO: space leaky: call hsc* directly?
997 (desugarModule =<< typecheckModule =<< parseModule modSummary)
998 liftM (gutsToCoreModule (mg_safe_haskell mod_guts)) $
999 if simplify
1000 then do
1001 -- If simplify is true: simplify (hscSimplify), then tidy
1002 -- (tidyProgram).
1003 hsc_env <- getSession
1004 simpl_guts <- liftIO $ hscSimplify hsc_env mod_guts
1005 tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
1006 return $ Left tidy_guts
1007 else
1008 return $ Right mod_guts
1009
1010 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1011 module dependency graph"
1012 where -- two versions, based on whether we simplify (thus run tidyProgram,
1013 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1014 -- we just have a ModGuts.
1015 gutsToCoreModule :: SafeHaskellMode
1016 -> Either (CgGuts, ModDetails) ModGuts
1017 -> CoreModule
1018 gutsToCoreModule safe_mode (Left (cg, md)) = CoreModule {
1019 cm_module = cg_module cg,
1020 cm_types = md_types md,
1021 cm_binds = cg_binds cg,
1022 cm_safe = safe_mode
1023 }
1024 gutsToCoreModule safe_mode (Right mg) = CoreModule {
1025 cm_module = mg_module mg,
1026 cm_types = typeEnvFromEntities (bindersOfBinds (mg_binds mg))
1027 (mg_tcs mg)
1028 (mg_fam_insts mg),
1029 cm_binds = mg_binds mg,
1030 cm_safe = safe_mode
1031 }
1032
1033 -- %************************************************************************
1034 -- %* *
1035 -- Inspecting the session
1036 -- %* *
1037 -- %************************************************************************
1038
1039 -- | Get the module dependency graph.
1040 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
1041 getModuleGraph = liftM hsc_mod_graph getSession
1042
1043 -- | Determines whether a set of modules requires Template Haskell.
1044 --
1045 -- Note that if the session's 'DynFlags' enabled Template Haskell when
1046 -- 'depanal' was called, then each module in the returned module graph will
1047 -- have Template Haskell enabled whether it is actually needed or not.
1048 needsTemplateHaskell :: ModuleGraph -> Bool
1049 needsTemplateHaskell ms =
1050 any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms
1051
1052 -- | Return @True@ <==> module is loaded.
1053 isLoaded :: GhcMonad m => ModuleName -> m Bool
1054 isLoaded m = withSession $ \hsc_env ->
1055 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
1056
1057 -- | Return the bindings for the current interactive session.
1058 getBindings :: GhcMonad m => m [TyThing]
1059 getBindings = withSession $ \hsc_env ->
1060 return $ icInScopeTTs $ hsc_IC hsc_env
1061
1062 -- | Return the instances for the current interactive session.
1063 getInsts :: GhcMonad m => m ([ClsInst], [FamInst])
1064 getInsts = withSession $ \hsc_env ->
1065 return $ ic_instances (hsc_IC hsc_env)
1066
1067 getPrintUnqual :: GhcMonad m => m PrintUnqualified
1068 getPrintUnqual = withSession $ \hsc_env ->
1069 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
1070
1071 -- | Container for information about a 'Module'.
1072 data ModuleInfo = ModuleInfo {
1073 minf_type_env :: TypeEnv,
1074 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
1075 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
1076 minf_instances :: [ClsInst],
1077 minf_iface :: Maybe ModIface,
1078 minf_safe :: SafeHaskellMode
1079 #ifdef GHCI
1080 ,minf_modBreaks :: ModBreaks
1081 #endif
1082 }
1083 -- We don't want HomeModInfo here, because a ModuleInfo applies
1084 -- to package modules too.
1085
1086 -- | Request information about a loaded 'Module'
1087 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
1088 getModuleInfo mdl = withSession $ \hsc_env -> do
1089 let mg = hsc_mod_graph hsc_env
1090 if mdl `elem` map ms_mod mg
1091 then liftIO $ getHomeModuleInfo hsc_env mdl
1092 else do
1093 {- if isHomeModule (hsc_dflags hsc_env) mdl
1094 then return Nothing
1095 else -} liftIO $ getPackageModuleInfo hsc_env mdl
1096 -- ToDo: we don't understand what the following comment means.
1097 -- (SDM, 19/7/2011)
1098 -- getPackageModuleInfo will attempt to find the interface, so
1099 -- we don't want to call it for a home module, just in case there
1100 -- was a problem loading the module and the interface doesn't
1101 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
1102
1103 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
1104 #ifdef GHCI
1105 getPackageModuleInfo hsc_env mdl
1106 = do eps <- hscEPS hsc_env
1107 iface <- hscGetModuleInterface hsc_env mdl
1108 let
1109 avails = mi_exports iface
1110 names = availsToNameSet avails
1111 pte = eps_PTE eps
1112 tys = [ ty | name <- concatMap availNames avails,
1113 Just ty <- [lookupTypeEnv pte name] ]
1114 --
1115 return (Just (ModuleInfo {
1116 minf_type_env = mkTypeEnv tys,
1117 minf_exports = names,
1118 minf_rdr_env = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
1119 minf_instances = error "getModuleInfo: instances for package module unimplemented",
1120 minf_iface = Just iface,
1121 minf_safe = getSafeMode $ mi_trust iface,
1122 minf_modBreaks = emptyModBreaks
1123 }))
1124 #else
1125 -- bogusly different for non-GHCI (ToDo)
1126 getPackageModuleInfo _hsc_env _mdl = do
1127 return Nothing
1128 #endif
1129
1130 getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
1131 getHomeModuleInfo hsc_env mdl =
1132 case lookupUFM (hsc_HPT hsc_env) (moduleName mdl) of
1133 Nothing -> return Nothing
1134 Just hmi -> do
1135 let details = hm_details hmi
1136 iface = hm_iface hmi
1137 return (Just (ModuleInfo {
1138 minf_type_env = md_types details,
1139 minf_exports = availsToNameSet (md_exports details),
1140 minf_rdr_env = mi_globals $! hm_iface hmi,
1141 minf_instances = md_insts details,
1142 minf_iface = Just iface,
1143 minf_safe = getSafeMode $ mi_trust iface
1144 #ifdef GHCI
1145 ,minf_modBreaks = getModBreaks hmi
1146 #endif
1147 }))
1148
1149 -- | The list of top-level entities defined in a module
1150 modInfoTyThings :: ModuleInfo -> [TyThing]
1151 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
1152
1153 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
1154 modInfoTopLevelScope minf
1155 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
1156
1157 modInfoExports :: ModuleInfo -> [Name]
1158 modInfoExports minf = nameSetElems $! minf_exports minf
1159
1160 -- | Returns the instances defined by the specified module.
1161 -- Warning: currently unimplemented for package modules.
1162 modInfoInstances :: ModuleInfo -> [ClsInst]
1163 modInfoInstances = minf_instances
1164
1165 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
1166 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
1167
1168 mkPrintUnqualifiedForModule :: GhcMonad m =>
1169 ModuleInfo
1170 -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
1171 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
1172 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
1173
1174 modInfoLookupName :: GhcMonad m =>
1175 ModuleInfo -> Name
1176 -> m (Maybe TyThing) -- XXX: returns a Maybe X
1177 modInfoLookupName minf name = withSession $ \hsc_env -> do
1178 case lookupTypeEnv (minf_type_env minf) name of
1179 Just tyThing -> return (Just tyThing)
1180 Nothing -> do
1181 eps <- liftIO $ readIORef (hsc_EPS hsc_env)
1182 return $! lookupType (hsc_dflags hsc_env)
1183 (hsc_HPT hsc_env) (eps_PTE eps) name
1184
1185 modInfoIface :: ModuleInfo -> Maybe ModIface
1186 modInfoIface = minf_iface
1187
1188 -- | Retrieve module safe haskell mode
1189 modInfoSafe :: ModuleInfo -> SafeHaskellMode
1190 modInfoSafe = minf_safe
1191
1192 #ifdef GHCI
1193 modInfoModBreaks :: ModuleInfo -> ModBreaks
1194 modInfoModBreaks = minf_modBreaks
1195 #endif
1196
1197 isDictonaryId :: Id -> Bool
1198 isDictonaryId id
1199 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
1200
1201 -- | Looks up a global name: that is, any top-level name in any
1202 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
1203 -- the interactive context, and therefore does not require a preceding
1204 -- 'setContext'.
1205 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
1206 lookupGlobalName name = withSession $ \hsc_env -> do
1207 liftIO $ lookupTypeHscEnv hsc_env name
1208
1209 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
1210 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
1211 ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
1212 return (findAnns deserialize ann_env target)
1213
1214 #ifdef GHCI
1215 -- | get the GlobalRdrEnv for a session
1216 getGRE :: GhcMonad m => m GlobalRdrEnv
1217 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
1218 #endif
1219
1220 -- -----------------------------------------------------------------------------
1221
1222 {- ToDo: Move the primary logic here to compiler/main/Packages.hs
1223 -- | Return all /external/ modules available in the package database.
1224 -- Modules from the current session (i.e., from the 'HomePackageTable') are
1225 -- not included. This includes module names which are reexported by packages.
1226 packageDbModules :: GhcMonad m =>
1227 Bool -- ^ Only consider exposed packages.
1228 -> m [Module]
1229 packageDbModules only_exposed = do
1230 dflags <- getSessionDynFlags
1231 let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
1232 return $
1233 [ mkModule pid modname
1234 | p <- pkgs
1235 , not only_exposed || exposed p
1236 , let pid = packageConfigId p
1237 , modname <- exposedModules p
1238 ++ map exportName (reexportedModules p) ]
1239 -}
1240
1241 -- -----------------------------------------------------------------------------
1242 -- Misc exported utils
1243
1244 dataConType :: DataCon -> Type
1245 dataConType dc = idType (dataConWrapId dc)
1246
1247 -- | print a 'NamedThing', adding parentheses if the name is an operator.
1248 pprParenSymName :: NamedThing a => a -> SDoc
1249 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
1250
1251 -- ----------------------------------------------------------------------------
1252
1253 #if 0
1254
1255 -- ToDo:
1256 -- - Data and Typeable instances for HsSyn.
1257
1258 -- ToDo: check for small transformations that happen to the syntax in
1259 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1260
1261 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
1262 -- to get from TyCons, Ids etc. to TH syntax (reify).
1263
1264 -- :browse will use either lm_toplev or inspect lm_interface, depending
1265 -- on whether the module is interpreted or not.
1266
1267 #endif
1268
1269 -- Extract the filename, stringbuffer content and dynflags associed to a module
1270 --
1271 -- XXX: Explain pre-conditions
1272 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
1273 getModuleSourceAndFlags mod = do
1274 m <- getModSummary (moduleName mod)
1275 case ml_hs_file $ ms_location m of
1276 Nothing -> do dflags <- getDynFlags
1277 liftIO $ throwIO $ mkApiErr dflags (text "No source available for module " <+> ppr mod)
1278 Just sourceFile -> do
1279 source <- liftIO $ hGetStringBuffer sourceFile
1280 return (sourceFile, source, ms_hspp_opts m)
1281
1282
1283 -- | Return module source as token stream, including comments.
1284 --
1285 -- The module must be in the module graph and its source must be available.
1286 -- Throws a 'HscTypes.SourceError' on parse error.
1287 getTokenStream :: GhcMonad m => Module -> m [Located Token]
1288 getTokenStream mod = do
1289 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1290 let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
1291 case lexTokenStream source startLoc flags of
1292 POk _ ts -> return ts
1293 PFailed span err ->
1294 do dflags <- getDynFlags
1295 liftIO $ throwIO $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
1296
1297 -- | Give even more information on the source than 'getTokenStream'
1298 -- This function allows reconstructing the source completely with
1299 -- 'showRichTokenStream'.
1300 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
1301 getRichTokenStream mod = do
1302 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1303 let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
1304 case lexTokenStream source startLoc flags of
1305 POk _ ts -> return $ addSourceToTokens startLoc source ts
1306 PFailed span err ->
1307 do dflags <- getDynFlags
1308 liftIO $ throwIO $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
1309
1310 -- | Given a source location and a StringBuffer corresponding to this
1311 -- location, return a rich token stream with the source associated to the
1312 -- tokens.
1313 addSourceToTokens :: RealSrcLoc -> StringBuffer -> [Located Token]
1314 -> [(Located Token, String)]
1315 addSourceToTokens _ _ [] = []
1316 addSourceToTokens loc buf (t@(L span _) : ts)
1317 = case span of
1318 UnhelpfulSpan _ -> (t,"") : addSourceToTokens loc buf ts
1319 RealSrcSpan s -> (t,str) : addSourceToTokens newLoc newBuf ts
1320 where
1321 (newLoc, newBuf, str) = go "" loc buf
1322 start = realSrcSpanStart s
1323 end = realSrcSpanEnd s
1324 go acc loc buf | loc < start = go acc nLoc nBuf
1325 | start <= loc && loc < end = go (ch:acc) nLoc nBuf
1326 | otherwise = (loc, buf, reverse acc)
1327 where (ch, nBuf) = nextChar buf
1328 nLoc = advanceSrcLoc loc ch
1329
1330
1331 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
1332 -- return source code almost identical to the original code (except for
1333 -- insignificant whitespace.)
1334 showRichTokenStream :: [(Located Token, String)] -> String
1335 showRichTokenStream ts = go startLoc ts ""
1336 where sourceFile = getFile $ map (getLoc . fst) ts
1337 getFile [] = panic "showRichTokenStream: No source file found"
1338 getFile (UnhelpfulSpan _ : xs) = getFile xs
1339 getFile (RealSrcSpan s : _) = srcSpanFile s
1340 startLoc = mkRealSrcLoc sourceFile 1 1
1341 go _ [] = id
1342 go loc ((L span _, str):ts)
1343 = case span of
1344 UnhelpfulSpan _ -> go loc ts
1345 RealSrcSpan s
1346 | locLine == tokLine -> ((replicate (tokCol - locCol) ' ') ++)
1347 . (str ++)
1348 . go tokEnd ts
1349 | otherwise -> ((replicate (tokLine - locLine) '\n') ++)
1350 . ((replicate (tokCol - 1) ' ') ++)
1351 . (str ++)
1352 . go tokEnd ts
1353 where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
1354 (tokLine, tokCol) = (srcSpanStartLine s, srcSpanStartCol s)
1355 tokEnd = realSrcSpanEnd s
1356
1357 -- -----------------------------------------------------------------------------
1358 -- Interactive evaluation
1359
1360 -- | Takes a 'ModuleName' and possibly a 'UnitId', and consults the
1361 -- filesystem and package database to find the corresponding 'Module',
1362 -- using the algorithm that is used for an @import@ declaration.
1363 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1364 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
1365 let
1366 dflags = hsc_dflags hsc_env
1367 this_pkg = thisPackage dflags
1368 --
1369 case maybe_pkg of
1370 Just pkg | fsToUnitId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
1371 res <- findImportedModule hsc_env mod_name maybe_pkg
1372 case res of
1373 Found _ m -> return m
1374 err -> throwOneError $ noModError dflags noSrcSpan mod_name err
1375 _otherwise -> do
1376 home <- lookupLoadedHomeModule mod_name
1377 case home of
1378 Just m -> return m
1379 Nothing -> liftIO $ do
1380 res <- findImportedModule hsc_env mod_name maybe_pkg
1381 case res of
1382 Found loc m | moduleUnitId m /= this_pkg -> return m
1383 | otherwise -> modNotLoadedError dflags m loc
1384 err -> throwOneError $ noModError dflags noSrcSpan mod_name err
1385
1386 modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a
1387 modNotLoadedError dflags m loc = throwGhcExceptionIO $ CmdLineError $ showSDoc dflags $
1388 text "module is not loaded:" <+>
1389 quotes (ppr (moduleName m)) <+>
1390 parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
1391
1392 -- | Like 'findModule', but differs slightly when the module refers to
1393 -- a source file, and the file has not been loaded via 'load'. In
1394 -- this case, 'findModule' will throw an error (module not loaded),
1395 -- but 'lookupModule' will check to see whether the module can also be
1396 -- found in a package, and if so, that package 'Module' will be
1397 -- returned. If not, the usual module-not-found error will be thrown.
1398 --
1399 lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1400 lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
1401 lookupModule mod_name Nothing = withSession $ \hsc_env -> do
1402 home <- lookupLoadedHomeModule mod_name
1403 case home of
1404 Just m -> return m
1405 Nothing -> liftIO $ do
1406 res <- findExposedPackageModule hsc_env mod_name Nothing
1407 case res of
1408 Found _ m -> return m
1409 err -> throwOneError $ noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
1410
1411 lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
1412 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
1413 case lookupUFM (hsc_HPT hsc_env) mod_name of
1414 Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
1415 _not_a_home_module -> return Nothing
1416
1417 #ifdef GHCI
1418 -- | Check that a module is safe to import (according to Safe Haskell).
1419 --
1420 -- We return True to indicate the import is safe and False otherwise
1421 -- although in the False case an error may be thrown first.
1422 isModuleTrusted :: GhcMonad m => Module -> m Bool
1423 isModuleTrusted m = withSession $ \hsc_env ->
1424 liftIO $ hscCheckSafe hsc_env m noSrcSpan
1425
1426 -- | Return if a module is trusted and the pkgs it depends on to be trusted.
1427 moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [UnitId])
1428 moduleTrustReqs m = withSession $ \hsc_env ->
1429 liftIO $ hscGetSafe hsc_env m noSrcSpan
1430
1431 -- | Set the monad GHCi lifts user statements into.
1432 --
1433 -- Checks that a type (in string form) is an instance of the
1434 -- @GHC.GHCi.GHCiSandboxIO@ type class. Sets it to be the GHCi monad if it is,
1435 -- throws an error otherwise.
1436 setGHCiMonad :: GhcMonad m => String -> m ()
1437 setGHCiMonad name = withSession $ \hsc_env -> do
1438 ty <- liftIO $ hscIsGHCiMonad hsc_env name
1439 modifySession $ \s ->
1440 let ic = (hsc_IC s) { ic_monad = ty }
1441 in s { hsc_IC = ic }
1442
1443 -- | Get the monad GHCi lifts user statements into.
1444 getGHCiMonad :: GhcMonad m => m Name
1445 getGHCiMonad = fmap (ic_monad . hsc_IC) getSession
1446
1447 getHistorySpan :: GhcMonad m => History -> m SrcSpan
1448 getHistorySpan h = withSession $ \hsc_env ->
1449 return $ InteractiveEval.getHistorySpan hsc_env h
1450
1451 obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term
1452 obtainTermFromVal bound force ty a = withSession $ \hsc_env ->
1453 liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
1454
1455 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
1456 obtainTermFromId bound force id = withSession $ \hsc_env ->
1457 liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
1458
1459 #endif
1460
1461 -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
1462 -- entity known to GHC, including 'Name's defined using 'runStmt'.
1463 lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
1464 lookupName name =
1465 withSession $ \hsc_env ->
1466 liftIO $ hscTcRcLookupName hsc_env name
1467
1468 -- -----------------------------------------------------------------------------
1469 -- Pure API
1470
1471 -- | A pure interface to the module parser.
1472 --
1473 parser :: String -- ^ Haskell module source text (full Unicode is supported)
1474 -> DynFlags -- ^ the flags
1475 -> FilePath -- ^ the filename (for source locations)
1476 -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
1477
1478 parser str dflags filename =
1479 let
1480 loc = mkRealSrcLoc (mkFastString filename) 1 1
1481 buf = stringToStringBuffer str
1482 in
1483 case unP Parser.parseModule (mkPState dflags buf loc) of
1484
1485 PFailed span err ->
1486 Left (unitBag (mkPlainErrMsg dflags span err))
1487
1488 POk pst rdr_module ->
1489 let (warns,_) = getMessages pst in
1490 Right (warns, rdr_module)
1491