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