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