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