compiler: make sure we reject -O + HscInterpreted
[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' <- 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 [PackageKey]
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 {- Note [GHCi and -O]
638 ~~~~~~~~~~~~~~~~~~~~~
639 When using optimization, the compiler can introduce several things
640 (such as unboxed tuples) into the intermediate code, which GHCi later
641 chokes on since the bytecode interpreter can't handle this (and while
642 this is arguably a bug these aren't handled, there are no plans to fix
643 it.)
644
645 While the driver pipeline always checks for this particular erroneous
646 combination when parsing flags, we also need to check when we update
647 the flags; this is because API clients may parse flags but update the
648 DynFlags afterwords, before finally running code inside a session (see
649 T10052 and #10052).
650 -}
651
652 -- | Checks the set of new DynFlags for possibly erroneous option
653 -- combinations when invoking 'setSessionDynFlags' and friends, and if
654 -- found, returns a fixed copy (if possible).
655 checkNewDynFlags :: MonadIO m => DynFlags -> m DynFlags
656 checkNewDynFlags dflags
657 -- See Note [GHCi and -O]
658 | Left e <- checkOptLevel (optLevel dflags) dflags
659 = do liftIO $ warningMsg dflags (text e)
660 return (dflags { optLevel = 0 })
661 | otherwise
662 = return dflags
663
664 -- %************************************************************************
665 -- %* *
666 -- Setting, getting, and modifying the targets
667 -- %* *
668 -- %************************************************************************
669
670 -- ToDo: think about relative vs. absolute file paths. And what
671 -- happens when the current directory changes.
672
673 -- | Sets the targets for this session. Each target may be a module name
674 -- or a filename. The targets correspond to the set of root modules for
675 -- the program\/library. Unloading the current program is achieved by
676 -- setting the current set of targets to be empty, followed by 'load'.
677 setTargets :: GhcMonad m => [Target] -> m ()
678 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
679
680 -- | Returns the current set of targets
681 getTargets :: GhcMonad m => m [Target]
682 getTargets = withSession (return . hsc_targets)
683
684 -- | Add another target.
685 addTarget :: GhcMonad m => Target -> m ()
686 addTarget target
687 = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
688
689 -- | Remove a target
690 removeTarget :: GhcMonad m => TargetId -> m ()
691 removeTarget target_id
692 = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
693 where
694 filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
695
696 -- | Attempts to guess what Target a string refers to. This function
697 -- implements the @--make@/GHCi command-line syntax for filenames:
698 --
699 -- - if the string looks like a Haskell source filename, then interpret it
700 -- as such
701 --
702 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
703 -- then use that
704 --
705 -- - otherwise interpret the string as a module name
706 --
707 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
708 guessTarget str (Just phase)
709 = return (Target (TargetFile str (Just phase)) True Nothing)
710 guessTarget str Nothing
711 | isHaskellSrcFilename file
712 = return (target (TargetFile file Nothing))
713 | otherwise
714 = do exists <- liftIO $ doesFileExist hs_file
715 if exists
716 then return (target (TargetFile hs_file Nothing))
717 else do
718 exists <- liftIO $ doesFileExist lhs_file
719 if exists
720 then return (target (TargetFile lhs_file Nothing))
721 else do
722 if looksLikeModuleName file
723 then return (target (TargetModule (mkModuleName file)))
724 else do
725 dflags <- getDynFlags
726 liftIO $ throwGhcExceptionIO
727 (ProgramError (showSDoc dflags $
728 text "target" <+> quotes (text file) <+>
729 text "is not a module name or a source file"))
730 where
731 (file,obj_allowed)
732 | '*':rest <- str = (rest, False)
733 | otherwise = (str, True)
734
735 hs_file = file <.> "hs"
736 lhs_file = file <.> "lhs"
737
738 target tid = Target tid obj_allowed Nothing
739
740
741 -- | Inform GHC that the working directory has changed. GHC will flush
742 -- its cache of module locations, since it may no longer be valid.
743 --
744 -- Note: Before changing the working directory make sure all threads running
745 -- in the same session have stopped. If you change the working directory,
746 -- you should also unload the current program (set targets to empty,
747 -- followed by load).
748 workingDirectoryChanged :: GhcMonad m => m ()
749 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
750
751
752 -- %************************************************************************
753 -- %* *
754 -- Running phases one at a time
755 -- %* *
756 -- %************************************************************************
757
758 class ParsedMod m where
759 modSummary :: m -> ModSummary
760 parsedSource :: m -> ParsedSource
761
762 class ParsedMod m => TypecheckedMod m where
763 renamedSource :: m -> Maybe RenamedSource
764 typecheckedSource :: m -> TypecheckedSource
765 moduleInfo :: m -> ModuleInfo
766 tm_internals :: m -> (TcGblEnv, ModDetails)
767 -- ToDo: improvements that could be made here:
768 -- if the module succeeded renaming but not typechecking,
769 -- we can still get back the GlobalRdrEnv and exports, so
770 -- perhaps the ModuleInfo should be split up into separate
771 -- fields.
772
773 class TypecheckedMod m => DesugaredMod m where
774 coreModule :: m -> ModGuts
775
776 -- | The result of successful parsing.
777 data ParsedModule =
778 ParsedModule { pm_mod_summary :: ModSummary
779 , pm_parsed_source :: ParsedSource
780 , pm_extra_src_files :: [FilePath]
781 , pm_annotations :: ApiAnns }
782 -- See Note [Api annotations] in ApiAnnotation.hs
783
784 instance ParsedMod ParsedModule where
785 modSummary m = pm_mod_summary m
786 parsedSource m = pm_parsed_source m
787
788 -- | The result of successful typechecking. It also contains the parser
789 -- result.
790 data TypecheckedModule =
791 TypecheckedModule { tm_parsed_module :: ParsedModule
792 , tm_renamed_source :: Maybe RenamedSource
793 , tm_typechecked_source :: TypecheckedSource
794 , tm_checked_module_info :: ModuleInfo
795 , tm_internals_ :: (TcGblEnv, ModDetails)
796 }
797
798 instance ParsedMod TypecheckedModule where
799 modSummary m = modSummary (tm_parsed_module m)
800 parsedSource m = parsedSource (tm_parsed_module m)
801
802 instance TypecheckedMod TypecheckedModule where
803 renamedSource m = tm_renamed_source m
804 typecheckedSource m = tm_typechecked_source m
805 moduleInfo m = tm_checked_module_info m
806 tm_internals m = tm_internals_ m
807
808 -- | The result of successful desugaring (i.e., translation to core). Also
809 -- contains all the information of a typechecked module.
810 data DesugaredModule =
811 DesugaredModule { dm_typechecked_module :: TypecheckedModule
812 , dm_core_module :: ModGuts
813 }
814
815 instance ParsedMod DesugaredModule where
816 modSummary m = modSummary (dm_typechecked_module m)
817 parsedSource m = parsedSource (dm_typechecked_module m)
818
819 instance TypecheckedMod DesugaredModule where
820 renamedSource m = renamedSource (dm_typechecked_module m)
821 typecheckedSource m = typecheckedSource (dm_typechecked_module m)
822 moduleInfo m = moduleInfo (dm_typechecked_module m)
823 tm_internals m = tm_internals_ (dm_typechecked_module m)
824
825 instance DesugaredMod DesugaredModule where
826 coreModule m = dm_core_module m
827
828 type ParsedSource = Located (HsModule RdrName)
829 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
830 Maybe LHsDocString)
831 type TypecheckedSource = LHsBinds Id
832
833 -- NOTE:
834 -- - things that aren't in the output of the typechecker right now:
835 -- - the export list
836 -- - the imports
837 -- - type signatures
838 -- - type/data/newtype declarations
839 -- - class declarations
840 -- - instances
841 -- - extra things in the typechecker's output:
842 -- - default methods are turned into top-level decls.
843 -- - dictionary bindings
844
845 -- | Return the 'ModSummary' of a module with the given name.
846 --
847 -- The module must be part of the module graph (see 'hsc_mod_graph' and
848 -- 'ModuleGraph'). If this is not the case, this function will throw a
849 -- 'GhcApiError'.
850 --
851 -- This function ignores boot modules and requires that there is only one
852 -- non-boot module with the given name.
853 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
854 getModSummary mod = do
855 mg <- liftM hsc_mod_graph getSession
856 case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
857 [] -> do dflags <- getDynFlags
858 liftIO $ throwIO $ mkApiErr dflags (text "Module not part of module graph")
859 [ms] -> return ms
860 multiple -> do dflags <- getDynFlags
861 liftIO $ throwIO $ mkApiErr dflags (text "getModSummary is ambiguous: " <+> ppr multiple)
862
863 -- | Parse a module.
864 --
865 -- Throws a 'SourceError' on parse error.
866 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
867 parseModule ms = do
868 hsc_env <- getSession
869 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
870 hpm <- liftIO $ hscParse hsc_env_tmp ms
871 return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm)
872 (hpm_annotations hpm))
873 -- See Note [Api annotations] in ApiAnnotation.hs
874
875 -- | Typecheck and rename a parsed module.
876 --
877 -- Throws a 'SourceError' if either fails.
878 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
879 typecheckModule pmod = do
880 let ms = modSummary pmod
881 hsc_env <- getSession
882 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
883 (tc_gbl_env, rn_info)
884 <- liftIO $ hscTypecheckRename hsc_env_tmp ms $
885 HsParsedModule { hpm_module = parsedSource pmod,
886 hpm_src_files = pm_extra_src_files pmod,
887 hpm_annotations = pm_annotations pmod }
888 details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
889 safe <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env
890 return $
891 TypecheckedModule {
892 tm_internals_ = (tc_gbl_env, details),
893 tm_parsed_module = pmod,
894 tm_renamed_source = rn_info,
895 tm_typechecked_source = tcg_binds tc_gbl_env,
896 tm_checked_module_info =
897 ModuleInfo {
898 minf_type_env = md_types details,
899 minf_exports = availsToNameSet $ md_exports details,
900 minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
901 minf_instances = md_insts details,
902 minf_iface = Nothing,
903 minf_safe = safe
904 #ifdef GHCI
905 ,minf_modBreaks = emptyModBreaks
906 #endif
907 }}
908
909 -- | Desugar a typechecked module.
910 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
911 desugarModule tcm = do
912 let ms = modSummary tcm
913 let (tcg, _) = tm_internals tcm
914 hsc_env <- getSession
915 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
916 guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg
917 return $
918 DesugaredModule {
919 dm_typechecked_module = tcm,
920 dm_core_module = guts
921 }
922
923 -- | Load a module. Input doesn't need to be desugared.
924 --
925 -- A module must be loaded before dependent modules can be typechecked. This
926 -- always includes generating a 'ModIface' and, depending on the
927 -- 'DynFlags.hscTarget', may also include code generation.
928 --
929 -- This function will always cause recompilation and will always overwrite
930 -- previous compilation results (potentially files on disk).
931 --
932 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
933 loadModule tcm = do
934 let ms = modSummary tcm
935 let mod = ms_mod_name ms
936 let loc = ms_location ms
937 let (tcg, _details) = tm_internals tcm
938
939 mb_linkable <- case ms_obj_date ms of
940 Just t | t > ms_hs_date ms -> do
941 l <- liftIO $ findObjectLinkable (ms_mod ms)
942 (ml_obj_file loc) t
943 return (Just l)
944 _otherwise -> return Nothing
945
946 let source_modified | isNothing mb_linkable = SourceModified
947 | otherwise = SourceUnmodified
948 -- we can't determine stability here
949
950 -- compile doesn't change the session
951 hsc_env <- getSession
952 mod_info <- liftIO $ compileOne' (Just tcg) Nothing
953 hsc_env ms 1 1 Nothing mb_linkable
954 source_modified
955
956 modifySession $ \e -> e{ hsc_HPT = addToUFM (hsc_HPT e) mod mod_info }
957 return tcm
958
959
960 -- %************************************************************************
961 -- %* *
962 -- Dealing with Core
963 -- %* *
964 -- %************************************************************************
965
966 -- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
967 -- the 'GHC.compileToCoreModule' interface.
968 data CoreModule
969 = CoreModule {
970 -- | Module name
971 cm_module :: !Module,
972 -- | Type environment for types declared in this module
973 cm_types :: !TypeEnv,
974 -- | Declarations
975 cm_binds :: CoreProgram,
976 -- | Safe Haskell mode
977 cm_safe :: SafeHaskellMode
978 }
979
980 instance Outputable CoreModule where
981 ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb,
982 cm_safe = sf})
983 = text "%module" <+> ppr mn <+> parens (ppr sf) <+> ppr te
984 $$ vcat (map ppr cb)
985
986 -- | This is the way to get access to the Core bindings corresponding
987 -- to a module. 'compileToCore' parses, typechecks, and
988 -- desugars the module, then returns the resulting Core module (consisting of
989 -- the module name, type declarations, and function declarations) if
990 -- successful.
991 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
992 compileToCoreModule = compileCore False
993
994 -- | Like compileToCoreModule, but invokes the simplifier, so
995 -- as to return simplified and tidied Core.
996 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
997 compileToCoreSimplified = compileCore True
998
999 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
1000 compileCore simplify fn = do
1001 -- First, set the target to the desired filename
1002 target <- guessTarget fn Nothing
1003 addTarget target
1004 _ <- load LoadAllTargets
1005 -- Then find dependencies
1006 modGraph <- depanal [] True
1007 case find ((== fn) . msHsFilePath) modGraph of
1008 Just modSummary -> do
1009 -- Now we have the module name;
1010 -- parse, typecheck and desugar the module
1011 mod_guts <- coreModule `fmap`
1012 -- TODO: space leaky: call hsc* directly?
1013 (desugarModule =<< typecheckModule =<< parseModule modSummary)
1014 liftM (gutsToCoreModule (mg_safe_haskell mod_guts)) $
1015 if simplify
1016 then do
1017 -- If simplify is true: simplify (hscSimplify), then tidy
1018 -- (tidyProgram).
1019 hsc_env <- getSession
1020 simpl_guts <- liftIO $ hscSimplify hsc_env mod_guts
1021 tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
1022 return $ Left tidy_guts
1023 else
1024 return $ Right mod_guts
1025
1026 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1027 module dependency graph"
1028 where -- two versions, based on whether we simplify (thus run tidyProgram,
1029 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1030 -- we just have a ModGuts.
1031 gutsToCoreModule :: SafeHaskellMode
1032 -> Either (CgGuts, ModDetails) ModGuts
1033 -> CoreModule
1034 gutsToCoreModule safe_mode (Left (cg, md)) = CoreModule {
1035 cm_module = cg_module cg,
1036 cm_types = md_types md,
1037 cm_binds = cg_binds cg,
1038 cm_safe = safe_mode
1039 }
1040 gutsToCoreModule safe_mode (Right mg) = CoreModule {
1041 cm_module = mg_module mg,
1042 cm_types = typeEnvFromEntities (bindersOfBinds (mg_binds mg))
1043 (mg_tcs mg)
1044 (mg_fam_insts mg),
1045 cm_binds = mg_binds mg,
1046 cm_safe = safe_mode
1047 }
1048
1049 -- %************************************************************************
1050 -- %* *
1051 -- Inspecting the session
1052 -- %* *
1053 -- %************************************************************************
1054
1055 -- | Get the module dependency graph.
1056 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
1057 getModuleGraph = liftM hsc_mod_graph getSession
1058
1059 -- | Determines whether a set of modules requires Template Haskell.
1060 --
1061 -- Note that if the session's 'DynFlags' enabled Template Haskell when
1062 -- 'depanal' was called, then each module in the returned module graph will
1063 -- have Template Haskell enabled whether it is actually needed or not.
1064 needsTemplateHaskell :: ModuleGraph -> Bool
1065 needsTemplateHaskell ms =
1066 any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms
1067
1068 -- | Return @True@ <==> module is loaded.
1069 isLoaded :: GhcMonad m => ModuleName -> m Bool
1070 isLoaded m = withSession $ \hsc_env ->
1071 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
1072
1073 -- | Return the bindings for the current interactive session.
1074 getBindings :: GhcMonad m => m [TyThing]
1075 getBindings = withSession $ \hsc_env ->
1076 return $ icInScopeTTs $ hsc_IC hsc_env
1077
1078 -- | Return the instances for the current interactive session.
1079 getInsts :: GhcMonad m => m ([ClsInst], [FamInst])
1080 getInsts = withSession $ \hsc_env ->
1081 return $ ic_instances (hsc_IC hsc_env)
1082
1083 getPrintUnqual :: GhcMonad m => m PrintUnqualified
1084 getPrintUnqual = withSession $ \hsc_env ->
1085 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
1086
1087 -- | Container for information about a 'Module'.
1088 data ModuleInfo = ModuleInfo {
1089 minf_type_env :: TypeEnv,
1090 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
1091 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
1092 minf_instances :: [ClsInst],
1093 minf_iface :: Maybe ModIface,
1094 minf_safe :: SafeHaskellMode
1095 #ifdef GHCI
1096 ,minf_modBreaks :: ModBreaks
1097 #endif
1098 }
1099 -- We don't want HomeModInfo here, because a ModuleInfo applies
1100 -- to package modules too.
1101
1102 -- | Request information about a loaded 'Module'
1103 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
1104 getModuleInfo mdl = withSession $ \hsc_env -> do
1105 let mg = hsc_mod_graph hsc_env
1106 if mdl `elem` map ms_mod mg
1107 then liftIO $ getHomeModuleInfo hsc_env mdl
1108 else do
1109 {- if isHomeModule (hsc_dflags hsc_env) mdl
1110 then return Nothing
1111 else -} liftIO $ getPackageModuleInfo hsc_env mdl
1112 -- ToDo: we don't understand what the following comment means.
1113 -- (SDM, 19/7/2011)
1114 -- getPackageModuleInfo will attempt to find the interface, so
1115 -- we don't want to call it for a home module, just in case there
1116 -- was a problem loading the module and the interface doesn't
1117 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
1118
1119 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
1120 #ifdef GHCI
1121 getPackageModuleInfo hsc_env mdl
1122 = do eps <- hscEPS hsc_env
1123 iface <- hscGetModuleInterface hsc_env mdl
1124 let
1125 avails = mi_exports iface
1126 names = availsToNameSet avails
1127 pte = eps_PTE eps
1128 tys = [ ty | name <- concatMap availNames avails,
1129 Just ty <- [lookupTypeEnv pte name] ]
1130 --
1131 return (Just (ModuleInfo {
1132 minf_type_env = mkTypeEnv tys,
1133 minf_exports = names,
1134 minf_rdr_env = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
1135 minf_instances = error "getModuleInfo: instances for package module unimplemented",
1136 minf_iface = Just iface,
1137 minf_safe = getSafeMode $ mi_trust iface,
1138 minf_modBreaks = emptyModBreaks
1139 }))
1140 #else
1141 -- bogusly different for non-GHCI (ToDo)
1142 getPackageModuleInfo _hsc_env _mdl = do
1143 return Nothing
1144 #endif
1145
1146 getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
1147 getHomeModuleInfo hsc_env mdl =
1148 case lookupUFM (hsc_HPT hsc_env) (moduleName mdl) of
1149 Nothing -> return Nothing
1150 Just hmi -> do
1151 let details = hm_details hmi
1152 iface = hm_iface hmi
1153 return (Just (ModuleInfo {
1154 minf_type_env = md_types details,
1155 minf_exports = availsToNameSet (md_exports details),
1156 minf_rdr_env = mi_globals $! hm_iface hmi,
1157 minf_instances = md_insts details,
1158 minf_iface = Just iface,
1159 minf_safe = getSafeMode $ mi_trust iface
1160 #ifdef GHCI
1161 ,minf_modBreaks = getModBreaks hmi
1162 #endif
1163 }))
1164
1165 -- | The list of top-level entities defined in a module
1166 modInfoTyThings :: ModuleInfo -> [TyThing]
1167 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
1168
1169 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
1170 modInfoTopLevelScope minf
1171 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
1172
1173 modInfoExports :: ModuleInfo -> [Name]
1174 modInfoExports minf = nameSetElems $! minf_exports minf
1175
1176 -- | Returns the instances defined by the specified module.
1177 -- Warning: currently unimplemented for package modules.
1178 modInfoInstances :: ModuleInfo -> [ClsInst]
1179 modInfoInstances = minf_instances
1180
1181 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
1182 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
1183
1184 mkPrintUnqualifiedForModule :: GhcMonad m =>
1185 ModuleInfo
1186 -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
1187 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
1188 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
1189
1190 modInfoLookupName :: GhcMonad m =>
1191 ModuleInfo -> Name
1192 -> m (Maybe TyThing) -- XXX: returns a Maybe X
1193 modInfoLookupName minf name = withSession $ \hsc_env -> do
1194 case lookupTypeEnv (minf_type_env minf) name of
1195 Just tyThing -> return (Just tyThing)
1196 Nothing -> do
1197 eps <- liftIO $ readIORef (hsc_EPS hsc_env)
1198 return $! lookupType (hsc_dflags hsc_env)
1199 (hsc_HPT hsc_env) (eps_PTE eps) name
1200
1201 modInfoIface :: ModuleInfo -> Maybe ModIface
1202 modInfoIface = minf_iface
1203
1204 -- | Retrieve module safe haskell mode
1205 modInfoSafe :: ModuleInfo -> SafeHaskellMode
1206 modInfoSafe = minf_safe
1207
1208 #ifdef GHCI
1209 modInfoModBreaks :: ModuleInfo -> ModBreaks
1210 modInfoModBreaks = minf_modBreaks
1211 #endif
1212
1213 isDictonaryId :: Id -> Bool
1214 isDictonaryId id
1215 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
1216
1217 -- | Looks up a global name: that is, any top-level name in any
1218 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
1219 -- the interactive context, and therefore does not require a preceding
1220 -- 'setContext'.
1221 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
1222 lookupGlobalName name = withSession $ \hsc_env -> do
1223 liftIO $ lookupTypeHscEnv hsc_env name
1224
1225 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
1226 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
1227 ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
1228 return (findAnns deserialize ann_env target)
1229
1230 #ifdef GHCI
1231 -- | get the GlobalRdrEnv for a session
1232 getGRE :: GhcMonad m => m GlobalRdrEnv
1233 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
1234 #endif
1235
1236 -- -----------------------------------------------------------------------------
1237
1238 {- ToDo: Move the primary logic here to compiler/main/Packages.hs
1239 -- | Return all /external/ modules available in the package database.
1240 -- Modules from the current session (i.e., from the 'HomePackageTable') are
1241 -- not included. This includes module names which are reexported by packages.
1242 packageDbModules :: GhcMonad m =>
1243 Bool -- ^ Only consider exposed packages.
1244 -> m [Module]
1245 packageDbModules only_exposed = do
1246 dflags <- getSessionDynFlags
1247 let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
1248 return $
1249 [ mkModule pid modname
1250 | p <- pkgs
1251 , not only_exposed || exposed p
1252 , let pid = packageConfigId p
1253 , modname <- exposedModules p
1254 ++ map exportName (reexportedModules p) ]
1255 -}
1256
1257 -- -----------------------------------------------------------------------------
1258 -- Misc exported utils
1259
1260 dataConType :: DataCon -> Type
1261 dataConType dc = idType (dataConWrapId dc)
1262
1263 -- | print a 'NamedThing', adding parentheses if the name is an operator.
1264 pprParenSymName :: NamedThing a => a -> SDoc
1265 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
1266
1267 -- ----------------------------------------------------------------------------
1268
1269 #if 0
1270
1271 -- ToDo:
1272 -- - Data and Typeable instances for HsSyn.
1273
1274 -- ToDo: check for small transformations that happen to the syntax in
1275 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1276
1277 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
1278 -- to get from TyCons, Ids etc. to TH syntax (reify).
1279
1280 -- :browse will use either lm_toplev or inspect lm_interface, depending
1281 -- on whether the module is interpreted or not.
1282
1283 #endif
1284
1285 -- Extract the filename, stringbuffer content and dynflags associed to a module
1286 --
1287 -- XXX: Explain pre-conditions
1288 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
1289 getModuleSourceAndFlags mod = do
1290 m <- getModSummary (moduleName mod)
1291 case ml_hs_file $ ms_location m of
1292 Nothing -> do dflags <- getDynFlags
1293 liftIO $ throwIO $ mkApiErr dflags (text "No source available for module " <+> ppr mod)
1294 Just sourceFile -> do
1295 source <- liftIO $ hGetStringBuffer sourceFile
1296 return (sourceFile, source, ms_hspp_opts m)
1297
1298
1299 -- | Return module source as token stream, including comments.
1300 --
1301 -- The module must be in the module graph and its source must be available.
1302 -- Throws a 'HscTypes.SourceError' on parse error.
1303 getTokenStream :: GhcMonad m => Module -> m [Located Token]
1304 getTokenStream 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 ts
1309 PFailed span err ->
1310 do dflags <- getDynFlags
1311 liftIO $ throwIO $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
1312
1313 -- | Give even more information on the source than 'getTokenStream'
1314 -- This function allows reconstructing the source completely with
1315 -- 'showRichTokenStream'.
1316 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
1317 getRichTokenStream mod = do
1318 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1319 let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
1320 case lexTokenStream source startLoc flags of
1321 POk _ ts -> return $ addSourceToTokens startLoc source ts
1322 PFailed span err ->
1323 do dflags <- getDynFlags
1324 liftIO $ throwIO $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
1325
1326 -- | Given a source location and a StringBuffer corresponding to this
1327 -- location, return a rich token stream with the source associated to the
1328 -- tokens.
1329 addSourceToTokens :: RealSrcLoc -> StringBuffer -> [Located Token]
1330 -> [(Located Token, String)]
1331 addSourceToTokens _ _ [] = []
1332 addSourceToTokens loc buf (t@(L span _) : ts)
1333 = case span of
1334 UnhelpfulSpan _ -> (t,"") : addSourceToTokens loc buf ts
1335 RealSrcSpan s -> (t,str) : addSourceToTokens newLoc newBuf ts
1336 where
1337 (newLoc, newBuf, str) = go "" loc buf
1338 start = realSrcSpanStart s
1339 end = realSrcSpanEnd s
1340 go acc loc buf | loc < start = go acc nLoc nBuf
1341 | start <= loc && loc < end = go (ch:acc) nLoc nBuf
1342 | otherwise = (loc, buf, reverse acc)
1343 where (ch, nBuf) = nextChar buf
1344 nLoc = advanceSrcLoc loc ch
1345
1346
1347 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
1348 -- return source code almost identical to the original code (except for
1349 -- insignificant whitespace.)
1350 showRichTokenStream :: [(Located Token, String)] -> String
1351 showRichTokenStream ts = go startLoc ts ""
1352 where sourceFile = getFile $ map (getLoc . fst) ts
1353 getFile [] = panic "showRichTokenStream: No source file found"
1354 getFile (UnhelpfulSpan _ : xs) = getFile xs
1355 getFile (RealSrcSpan s : _) = srcSpanFile s
1356 startLoc = mkRealSrcLoc sourceFile 1 1
1357 go _ [] = id
1358 go loc ((L span _, str):ts)
1359 = case span of
1360 UnhelpfulSpan _ -> go loc ts
1361 RealSrcSpan s
1362 | locLine == tokLine -> ((replicate (tokCol - locCol) ' ') ++)
1363 . (str ++)
1364 . go tokEnd ts
1365 | otherwise -> ((replicate (tokLine - locLine) '\n') ++)
1366 . ((replicate (tokCol - 1) ' ') ++)
1367 . (str ++)
1368 . go tokEnd ts
1369 where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
1370 (tokLine, tokCol) = (srcSpanStartLine s, srcSpanStartCol s)
1371 tokEnd = realSrcSpanEnd s
1372
1373 -- -----------------------------------------------------------------------------
1374 -- Interactive evaluation
1375
1376 -- | Takes a 'ModuleName' and possibly a 'PackageKey', and consults the
1377 -- filesystem and package database to find the corresponding 'Module',
1378 -- using the algorithm that is used for an @import@ declaration.
1379 --
1380 -- However, there is a twist for local modules, see #2682.
1381 --
1382 -- The full algorithm:
1383 -- IF it's a package qualified import for a REMOTE package (not @this_pkg@ or
1384 -- this), do a normal lookup.
1385 -- OTHERWISE see if it is ALREADY loaded, and use it if it is.
1386 -- OTHERWISE do a normal lookup, but reject the result if the found result
1387 -- is from the LOCAL package (@this_pkg@).
1388 --
1389 -- For signatures, we return the BACKING implementation to keep the API
1390 -- consistent with what we had before. (ToDo: create a new GHC API which
1391 -- can deal with signatures.)
1392 --
1393 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1394 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
1395 let
1396 dflags = hsc_dflags hsc_env
1397 this_pkg = thisPackage dflags
1398 --
1399 case maybe_pkg of
1400 Just pkg | fsToPackageKey pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
1401 res <- findImportedModule hsc_env mod_name maybe_pkg
1402 case res of
1403 FoundModule h -> return (fr_mod h)
1404 FoundSigs _ backing -> return backing
1405 err -> throwOneError $ noModError dflags noSrcSpan mod_name err
1406 _otherwise -> do
1407 home <- lookupLoadedHomeModule mod_name
1408 case home of
1409 -- TODO: This COULD be a signature
1410 Just m -> return m
1411 Nothing -> liftIO $ do
1412 res <- findImportedModule hsc_env mod_name maybe_pkg
1413 case res of
1414 FoundModule (FoundHs { fr_mod = m, fr_loc = loc })
1415 | modulePackageKey m /= this_pkg -> return m
1416 | otherwise -> modNotLoadedError dflags m loc
1417 FoundSigs (FoundHs { fr_loc = loc, fr_mod = m }:_) backing
1418 | modulePackageKey m /= this_pkg -> return backing
1419 | otherwise -> modNotLoadedError dflags m loc
1420 err -> throwOneError $ noModError dflags noSrcSpan mod_name err
1421
1422 modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a
1423 modNotLoadedError dflags m loc = throwGhcExceptionIO $ CmdLineError $ showSDoc dflags $
1424 text "module is not loaded:" <+>
1425 quotes (ppr (moduleName m)) <+>
1426 parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
1427
1428 -- | Like 'findModule', but differs slightly when the module refers to
1429 -- a source file, and the file has not been loaded via 'load'. In
1430 -- this case, 'findModule' will throw an error (module not loaded),
1431 -- but 'lookupModule' will check to see whether the module can also be
1432 -- found in a package, and if so, that package 'Module' will be
1433 -- returned. If not, the usual module-not-found error will be thrown.
1434 --
1435 lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1436 lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
1437 lookupModule mod_name Nothing = withSession $ \hsc_env -> do
1438 home <- lookupLoadedHomeModule mod_name
1439 case home of
1440 -- TODO: This COULD be a signature
1441 Just m -> return m
1442 Nothing -> liftIO $ do
1443 res <- findExposedPackageModule hsc_env mod_name Nothing
1444 case res of
1445 FoundModule (FoundHs { fr_mod = m }) -> return m
1446 FoundSigs _ backing -> return backing
1447 err -> throwOneError $ noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
1448
1449 lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
1450 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
1451 case lookupUFM (hsc_HPT hsc_env) mod_name of
1452 Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
1453 _not_a_home_module -> return Nothing
1454
1455 #ifdef GHCI
1456 -- | Check that a module is safe to import (according to Safe Haskell).
1457 --
1458 -- We return True to indicate the import is safe and False otherwise
1459 -- although in the False case an error may be thrown first.
1460 isModuleTrusted :: GhcMonad m => Module -> m Bool
1461 isModuleTrusted m = withSession $ \hsc_env ->
1462 liftIO $ hscCheckSafe hsc_env m noSrcSpan
1463
1464 -- | Return if a module is trusted and the pkgs it depends on to be trusted.
1465 moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [PackageKey])
1466 moduleTrustReqs m = withSession $ \hsc_env ->
1467 liftIO $ hscGetSafe hsc_env m noSrcSpan
1468
1469 -- | Set the monad GHCi lifts user statements into.
1470 --
1471 -- Checks that a type (in string form) is an instance of the
1472 -- @GHC.GHCi.GHCiSandboxIO@ type class. Sets it to be the GHCi monad if it is,
1473 -- throws an error otherwise.
1474 setGHCiMonad :: GhcMonad m => String -> m ()
1475 setGHCiMonad name = withSession $ \hsc_env -> do
1476 ty <- liftIO $ hscIsGHCiMonad hsc_env name
1477 modifySession $ \s ->
1478 let ic = (hsc_IC s) { ic_monad = ty }
1479 in s { hsc_IC = ic }
1480
1481 getHistorySpan :: GhcMonad m => History -> m SrcSpan
1482 getHistorySpan h = withSession $ \hsc_env ->
1483 return $ InteractiveEval.getHistorySpan hsc_env h
1484
1485 obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term
1486 obtainTermFromVal bound force ty a = withSession $ \hsc_env ->
1487 liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
1488
1489 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
1490 obtainTermFromId bound force id = withSession $ \hsc_env ->
1491 liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
1492
1493 #endif
1494
1495 -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
1496 -- entity known to GHC, including 'Name's defined using 'runStmt'.
1497 lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
1498 lookupName name =
1499 withSession $ \hsc_env ->
1500 liftIO $ hscTcRcLookupName hsc_env name
1501
1502 -- -----------------------------------------------------------------------------
1503 -- Pure API
1504
1505 -- | A pure interface to the module parser.
1506 --
1507 parser :: String -- ^ Haskell module source text (full Unicode is supported)
1508 -> DynFlags -- ^ the flags
1509 -> FilePath -- ^ the filename (for source locations)
1510 -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
1511
1512 parser str dflags filename =
1513 let
1514 loc = mkRealSrcLoc (mkFastString filename) 1 1
1515 buf = stringToStringBuffer str
1516 in
1517 case unP Parser.parseModule (mkPState dflags buf loc) of
1518
1519 PFailed span err ->
1520 Left (unitBag (mkPlainErrMsg dflags span err))
1521
1522 POk pst rdr_module ->
1523 let (warns,_) = getMessages pst in
1524 Right (warns, rdr_module)
1525