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