GHC.hs 56 KB
Newer Older
1 2
{-# LANGUAGE CPP, NondecreasingIndentation, ScopedTypeVariables #-}

3
-- -----------------------------------------------------------------------------
4
--
Gabor Greif's avatar
Gabor Greif committed
5
-- (c) The University of Glasgow, 2005-2012
6 7 8
--
-- The GHC API
--
9
-- -----------------------------------------------------------------------------
10 11

module GHC (
dterei's avatar
dterei committed
12 13 14
        -- * Initialisation
        defaultErrorHandler,
        defaultCleanupHandler,
Ian Lynagh's avatar
Ian Lynagh committed
15
        prettyPrintGhcErrors,
16 17

        -- * GHC Monad
Simon Marlow's avatar
Simon Marlow committed
18
        Ghc, GhcT, GhcMonad(..), HscEnv,
19 20
        runGhc, runGhcT, initGhcMonad,
        gcatch, gbracket, gfinally,
21 22
        printException,
        handleSourceError,
23
        needsTemplateHaskell,
24

dterei's avatar
dterei committed
25
        -- * Flags and settings
ian@well-typed.com's avatar
ian@well-typed.com committed
26
        DynFlags(..), GeneralFlag(..), Severity(..), HscTarget(..), gopt,
27
        GhcMode(..), GhcLink(..), defaultObjectTarget,
dterei's avatar
dterei committed
28
        parseDynamicFlags,
29 30 31
        getSessionDynFlags, setSessionDynFlags,
        getProgramDynFlags, setProgramDynFlags,
        getInteractiveDynFlags, setInteractiveDynFlags,
dterei's avatar
dterei committed
32 33 34 35 36 37 38 39 40 41 42 43
        parseStaticFlags,

        -- * Targets
        Target(..), TargetId(..), Phase,
        setTargets,
        getTargets,
        addTarget,
        removeTarget,
        guessTarget,
        
        -- * Loading\/compiling the program
        depanal,
Simon Marlow's avatar
Simon Marlow committed
44
        load, LoadHowMuch(..), InteractiveImport(..),
dterei's avatar
dterei committed
45
        SuccessFlag(..), succeeded, failed,
46
        defaultWarnErrLogger, WarnErrLogger,
dterei's avatar
dterei committed
47
        workingDirectoryChanged,
48
        parseModule, typecheckModule, desugarModule, loadModule,
Thomas Schilling's avatar
Thomas Schilling committed
49
        ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),
dterei's avatar
dterei committed
50
        TypecheckedSource, ParsedSource, RenamedSource,   -- ditto
51
        TypecheckedMod, ParsedMod,
52 53
        moduleInfo, renamedSource, typecheckedSource,
        parsedSource, coreModule,
Simon Marlow's avatar
Simon Marlow committed
54 55 56

        -- ** Compiling to Core
        CoreModule(..),
57
        compileToCoreModule, compileToCoreSimplified,
58

dterei's avatar
dterei committed
59 60
        -- * Inspecting the module structure of the program
        ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
Simon Marlow's avatar
Simon Marlow committed
61 62
        getModSummary,
        getModuleGraph,
dterei's avatar
dterei committed
63 64 65 66 67 68 69 70
        isLoaded,
        topSortModuleGraph,

        -- * Inspecting modules
        ModuleInfo,
        getModuleInfo,
        modInfoTyThings,
        modInfoTopLevelScope,
71
        modInfoExports,
dterei's avatar
dterei committed
72 73 74
        modInfoInstances,
        modInfoIsExportedName,
        modInfoLookupName,
75
        modInfoIface,
76
        modInfoSafe,
dterei's avatar
--amend  
dterei committed
77 78
        lookupGlobalName,
        findGlobalAnns,
79
        mkPrintUnqualifiedForModule,
80
        ModIface(..),
81
        SafeHaskellMode(..),
82

83
        -- * Querying the environment
84
        -- packageDbModules,
85

dterei's avatar
dterei committed
86 87
        -- * Printing
        PrintUnqualified, alwaysQualify,
88

dterei's avatar
dterei committed
89
        -- * Interactive evaluation
90 91 92 93 94 95 96 97 98 99 100 101

#ifdef GHCI
        -- ** Executing statements
        execStmt, ExecOptions(..), execOptions, ExecResult(..),
        resumeExec,

        -- ** Adding new declarations
        runDecls, runDeclsWithLocation,

        -- ** Get/set the current context
        parseImportDecl,
        setContext, getContext,
102
        setGHCiMonad, getGHCiMonad,
103 104
#endif
        -- ** Inspecting the current context
dterei's avatar
dterei committed
105
        getBindings, getInsts, getPrintUnqual,
dterei's avatar
dterei committed
106
        findModule, lookupModule,
107
#ifdef GHCI
108
        isModuleTrusted, moduleTrustReqs,
dterei's avatar
dterei committed
109 110
        getNamesInScope,
        getRdrNamesInScope,
111
        getGRE,
dterei's avatar
dterei committed
112 113
        moduleIsInterpreted,
        getInfo,
114 115 116 117
        showModule,
        isModuleInterpreted,

        -- ** Inspecting types and kinds
dterei's avatar
dterei committed
118 119
        exprType,
        typeKind,
120 121

        -- ** Looking up a Name
dterei's avatar
dterei committed
122
        parseName,
123 124 125 126
#endif
        lookupName,
#ifdef GHCI
        -- ** Compiling expressions
127 128
        HValue, parseExpr, compileParsedExpr,
        InteractiveEval.compileExpr, dynCompileExpr,
129 130

        -- ** Other
131
        runTcInteractive,   -- Desired by some clients (Trac #8878)
132 133 134

        -- ** The debugger
        SingleStep(..),
135 136
        Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
               resumeHistory, resumeHistoryIx),
137
        History(historyBreakInfo, historyEnclosingDecls), 
138
        GHC.getHistorySpan, getHistoryModule,
139
        abandon, abandonAll,
140
        getResumeContext,
pepe's avatar
pepe committed
141
        GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
142
        modInfoModBreaks,
143 144
        ModBreaks(..), BreakIndex,
        BreakInfo(breakInfo_number, breakInfo_module),
145
        BreakArray, setBreakOn, setBreakOff, getBreak,
146 147
        InteractiveEval.back,
        InteractiveEval.forward,
148

149 150 151 152
        -- ** Deprecated API
        RunResult(..),
        runStmt, runStmtWithLocation,
        resume,
dterei's avatar
dterei committed
153 154
#endif

dterei's avatar
dterei committed
155
        -- * Abstract syntax elements
156

Simon Marlow's avatar
Simon Marlow committed
157
        -- ** Packages
158
        PackageKey,
Simon Marlow's avatar
Simon Marlow committed
159

dterei's avatar
dterei committed
160
        -- ** Modules
161
        Module, mkModule, pprModule, moduleName, modulePackageKey,
Simon Marlow's avatar
Simon Marlow committed
162
        ModuleName, mkModuleName, moduleNameString,
163

dterei's avatar
dterei committed
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
        -- ** Names
        Name, 
        isExternalName, nameModule, pprParenSymName, nameSrcSpan,
        NamedThing(..),
        RdrName(Qual,Unqual),
        
        -- ** Identifiers
        Id, idType,
        isImplicitId, isDeadBinder,
        isExportedId, isLocalId, isGlobalId,
        isRecordSelector,
        isPrimOpId, isFCallId, isClassOpId_maybe,
        isDataConWorkId, idDataCon,
        isBottomingId, isDictonaryId,
        recordSelectorFieldLabel,

        -- ** Type constructors
181
        TyCon,
dterei's avatar
dterei committed
182
        tyConTyVars, tyConDataCons, tyConArity,
183 184 185 186
        isClassTyCon, isTypeSynonymTyCon, isTypeFamilyTyCon, isNewTyCon,
        isPrimTyCon, isFunTyCon,
        isFamilyTyCon, isOpenFamilyTyCon, isOpenTypeFamilyTyCon,
        tyConClass_maybe,
187
        synTyConRhs_maybe, synTyConDefn_maybe, synTyConResKind,
dterei's avatar
dterei committed
188 189 190 191 192 193 194 195 196

        -- ** Type variables
        TyVar,
        alphaTyVars,

        -- ** Data constructors
        DataCon,
        dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
        dataConIsInfix, isVanillaDataCon, dataConUserType,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
197
        dataConSrcBangs,
dterei's avatar
dterei committed
198 199 200 201 202 203 204 205
        StrictnessMark(..), isMarkedStrict,

        -- ** Classes
        Class, 
        classMethods, classSCTheta, classTvsFds, classATs,
        pprFundeps,

        -- ** Instances
206
        ClsInst, 
dterei's avatar
dterei committed
207
        instanceDFunId, 
208
        pprInstance, pprInstanceHdr,
209
        pprFamInst,
210

211
        FamInst,
212

dterei's avatar
dterei committed
213 214 215 216 217 218
        -- ** Types and Kinds
        Type, splitForAllTys, funResultTy, 
        pprParendType, pprTypeApp, 
        Kind,
        PredType,
        ThetaType, pprForAll, pprThetaArrowTy,
219

dterei's avatar
dterei committed
220 221
        -- ** Entities
        TyThing(..), 
222

dterei's avatar
dterei committed
223 224
        -- ** Syntax
        module HsSyn, -- ToDo: remove extraneous bits
225

dterei's avatar
dterei committed
226 227 228 229 230
        -- ** Fixities
        FixityDirection(..), 
        defaultFixity, maxPrecedence, 
        negateFixity,
        compareFixity,
231

dterei's avatar
dterei committed
232 233
        -- ** Source locations
        SrcLoc(..), RealSrcLoc, 
Ian Lynagh's avatar
Ian Lynagh committed
234
        mkSrcLoc, noSrcLoc,
dterei's avatar
dterei committed
235
        srcLocFile, srcLocLine, srcLocCol,
236
        SrcSpan(..), RealSrcSpan,
Simon Marlow's avatar
Simon Marlow committed
237
        mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
Simon Marlow's avatar
Simon Marlow committed
238
        srcSpanStart, srcSpanEnd,
dterei's avatar
dterei committed
239
        srcSpanFile, 
Simon Marlow's avatar
Simon Marlow committed
240 241
        srcSpanStartLine, srcSpanEndLine, 
        srcSpanStartCol, srcSpanEndCol,
242

243
        -- ** Located
dterei's avatar
dterei committed
244
        GenLocated(..), Located,
245

dterei's avatar
dterei committed
246 247
        -- *** Constructing Located
        noLoc, mkGeneralLocated,
248

dterei's avatar
dterei committed
249 250
        -- *** Deconstructing Located
        getLoc, unLoc,
251

dterei's avatar
dterei committed
252 253
        -- *** Combining and comparing Located values
        eqLocated, cmpLocated, combineLocs, addCLoc,
254 255 256
        leftmost_smallest, leftmost_largest, rightmost,
        spans, isSubspanOf,

dterei's avatar
dterei committed
257 258
        -- * Exceptions
        GhcException(..), showGhcException,
259

Jedai's avatar
Jedai committed
260 261 262 263 264
        -- * Token stream manipulations
        Token,
        getTokenStream, getRichTokenStream,
        showRichTokenStream, addSourceToTokens,

265 266 267
        -- * Pure interface to the parser
        parser,

Alan Zimmerman's avatar
Alan Zimmerman committed
268 269
        -- * API Annotations
        ApiAnns,AnnKeywordId(..),AnnotationComment(..),
Alan Zimmerman's avatar
Alan Zimmerman committed
270 271
        getAnnotation, getAndRemoveAnnotation,
        getAnnotationComments, getAndRemoveAnnotationComments,
Alan Zimmerman's avatar
Alan Zimmerman committed
272

dterei's avatar
dterei committed
273 274 275
        -- * Miscellaneous
        --sessionHscEnv,
        cyclicModuleErr,
276 277
  ) where

278 279 280
{-
 ToDo:

281
  * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
282 283 284 285 286 287
  * what StaticFlags should we expose, if any?
-}

#include "HsVersions.h"

#ifdef GHCI
288
import ByteCodeInstr
289
import BreakArray
290
import InteractiveEval
291
import TcRnDriver       ( runTcInteractive )
292 293
#endif

294
import PprTyThing       ( pprFamInst )
295
import HscMain
296
import GhcMake
297
import DriverPipeline   ( compileOne' )
298
import GhcMonad
299
import TcRnMonad        ( finalSafeMode, fixSafeInstances )
300
import TcRnTypes
301 302 303
import Packages
import NameSet
import RdrName
Ian Lynagh's avatar
Ian Lynagh committed
304
import qualified HsSyn -- hack as we want to reexport the whole module
305
import HsSyn
batterseapower's avatar
batterseapower committed
306
import Type     hiding( typeKind )
dterei's avatar
dterei committed
307 308
import Kind             ( synTyConResKind )
import TcType           hiding( typeKind )
309
import Id
dterei's avatar
dterei committed
310
import TysPrim          ( alphaTyVars )
311 312 313 314
import TyCon
import Class
import DataCon
import Name             hiding ( varName )
315
import Avail
316
import InstEnv
317
import FamInstEnv ( FamInst )
318
import SrcLoc
319
import CoreSyn
320
import TidyPgm
321
import DriverPhases     ( Phase(..), isHaskellSrcFilename )
322 323 324
import Finder
import HscTypes
import DynFlags
325
import StaticFlags
326
import SysTools
327
import Annotations
328
import Module
329
import UniqFM
330
import Panic
331
import Platform
dterei's avatar
dterei committed
332
import Bag              ( unitBag )
333
import ErrUtils
334
import MonadUtils
335
import Util
336
import StringBuffer
337
import Outputable
338
import BasicTypes
dterei's avatar
dterei committed
339
import Maybes           ( expectJust )
340
import FastString
341
import qualified Parser
Jedai's avatar
Jedai committed
342
import Lexer
Alan Zimmerman's avatar
Alan Zimmerman committed
343
import ApiAnnotation
344

Austin Seipp's avatar
Austin Seipp committed
345
import System.Directory ( doesFileExist )
346
import Data.Maybe
dterei's avatar
dterei committed
347
import Data.List        ( find )
348
import Data.Time
349 350
import Data.Typeable    ( Typeable )
import Data.Word        ( Word8 )
351
import Control.Monad
dterei's avatar
dterei committed
352
import System.Exit      ( exitWith, ExitCode(..) )
353
import Exception
354
import Data.IORef
Ian Lynagh's avatar
Ian Lynagh committed
355
import System.FilePath
356
import System.IO
Ian Lynagh's avatar
Ian Lynagh committed
357
import Prelude hiding (init)
358

359

360
-- %************************************************************************
dterei's avatar
dterei committed
361
-- %*                                                                      *
362
--             Initialisation: exception handlers
dterei's avatar
dterei committed
363
-- %*                                                                      *
364 365
-- %************************************************************************

366 367 368 369 370

-- | Install some default exception handlers and run the inner computation.
-- Unless you want to handle exceptions yourself, you should wrap this around
-- the top level of your program.  The default handlers output the error
-- message(s) to stderr and exit cleanly.
371
defaultErrorHandler :: (ExceptionMonad m)
Ian Lynagh's avatar
Ian Lynagh committed
372 373
                    => FatalMessager -> FlushOut -> m a -> m a
defaultErrorHandler fm (FlushOut flushOut) inner =
374
  -- top-level exception handler: any unrecognised exception is a compiler bug.
375
  ghandle (\exception -> liftIO $ do
376
           flushOut
377
           case fromException exception of
378 379
                -- an IO exception probably isn't our fault, so don't panic
                Just (ioe :: IOException) ->
Ian Lynagh's avatar
Ian Lynagh committed
380
                  fatalErrorMsg'' fm (show ioe)
381
                _ -> case fromException exception of
382 383 384 385
                     Just UserInterrupt ->
                         -- Important to let this one propagate out so our
                         -- calling process knows we were interrupted by ^C
                         liftIO $ throwIO UserInterrupt
386
                     Just StackOverflow ->
Ian Lynagh's avatar
Ian Lynagh committed
387
                         fatalErrorMsg'' fm "stack overflow: use +RTS -K<size> to increase it"
388
                     _ -> case fromException exception of
389
                          Just (ex :: ExitCode) -> liftIO $ throwIO ex
390
                          _ ->
Ian Lynagh's avatar
Ian Lynagh committed
391 392
                              fatalErrorMsg'' fm
                                  (show (Panic (show exception)))
393
           exitWith (ExitFailure 1)
394 395
         ) $

396
  -- error messages propagated as exceptions
397
  handleGhcException
398
            (\ge -> liftIO $ do
399
                flushOut
dterei's avatar
dterei committed
400 401 402
                case ge of
                     PhaseFailed _ code -> exitWith code
                     Signal _ -> exitWith (ExitFailure 1)
Ian Lynagh's avatar
Ian Lynagh committed
403
                     _ -> do fatalErrorMsg'' fm (show ge)
dterei's avatar
dterei committed
404 405
                             exitWith (ExitFailure 1)
            ) $
406 407
  inner

408
-- | Install a default cleanup handler to remove temporary files deposited by
Gabor Greif's avatar
Gabor Greif committed
409
-- a GHC run.  This is separate from 'defaultErrorHandler', because you might
410 411
-- want to override the error handling, but still get the ordinary cleanup
-- behaviour.
412
defaultCleanupHandler :: (ExceptionMonad m) =>
413 414
                         DynFlags -> m a -> m a
defaultCleanupHandler dflags inner =
415
    -- make sure we clean up after ourselves
416
    inner `gfinally`
417 418
          (liftIO $ do
              cleanTempFiles dflags
419
              cleanTempDirs dflags
420
          )
421
          --  exceptions will be blocked while we clean the temporary files,
422 423
          -- so there shouldn't be any difficulty if we receive further
          -- signals.
424

425

426
-- %************************************************************************
dterei's avatar
dterei committed
427
-- %*                                                                      *
428
--             The Ghc Monad
dterei's avatar
dterei committed
429
-- %*                                                                      *
430
-- %************************************************************************
431 432 433 434 435 436 437 438 439 440 441 442 443 444

-- | Run function for the 'Ghc' monad.
--
-- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call
-- to this function will create a new session which should not be shared among
-- several threads.
--
-- Any errors not handled inside the 'Ghc' action are propagated as IO
-- exceptions.

runGhc :: Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
       -> Ghc a           -- ^ The action to perform.
       -> IO a
runGhc mb_top_dir ghc = do
445
  ref <- newIORef (panic "empty session")
446
  let session = Session ref
447 448 449 450 451 452 453 454 455 456 457
  flip unGhc session $ do
    initGhcMonad mb_top_dir
    ghc
  -- XXX: unregister interrupt handlers here?

-- | Run function for 'GhcT' monad transformer.
--
-- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call
-- to this function will create a new session which should not be shared among
-- several threads.

458
#if __GLASGOW_HASKELL__ < 710
Simon Peyton Jones's avatar
Simon Peyton Jones committed
459
-- Pre-AMP change
460 461 462 463
runGhcT :: (ExceptionMonad m, Functor m) =>
#else
runGhcT :: (ExceptionMonad m) =>
#endif
464 465 466 467
           Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
        -> GhcT m a        -- ^ The action to perform.
        -> m a
runGhcT mb_top_dir ghct = do
468
  ref <- liftIO $ newIORef (panic "empty session")
469
  let session = Session ref
470 471 472 473 474 475 476 477 478 479 480 481 482 483
  flip unGhcT session $ do
    initGhcMonad mb_top_dir
    ghct

-- | Initialise a GHC session.
--
-- If you implement a custom 'GhcMonad' you must call this function in the
-- monad run function.  It will initialise the session variable and clear all
-- warnings.
--
-- The first argument should point to the directory where GHC's library files
-- reside.  More precisely, this should be the output of @ghc --print-libdir@
-- of the version of GHC the module using this API is compiled with.  For
-- portability, you should use the @ghc-paths@ package, available at
484
-- <http://hackage.haskell.org/package/ghc-paths>.
485 486

initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
487 488 489 490 491 492
initGhcMonad mb_top_dir
  = do { env <- liftIO $
                do { installSignalHandlers  -- catch ^C
                   ; initStaticOpts
                   ; mySettings <- initSysTools mb_top_dir
                   ; dflags <- initDynFlags (defaultDynFlags mySettings)
493
                   ; checkBrokenTablesNextToCode dflags
494 495 496 497 498
                   ; setUnsafeGlobalDynFlags dflags
                      -- c.f. DynFlags.parseDynamicFlagsFull, which
                      -- creates DynFlags and sets the UnsafeGlobalDynFlags
                   ; newHscEnv dflags }
       ; setSession env }
499

500 501 502 503 504 505 506 507 508 509
-- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which
-- breaks tables-next-to-code in dynamically linked modules. This
-- check should be more selective but there is currently no released
-- version where this bug is fixed.
-- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and
-- https://ghc.haskell.org/trac/ghc/ticket/4210#comment:29
checkBrokenTablesNextToCode :: MonadIO m => DynFlags -> m ()
checkBrokenTablesNextToCode dflags
  = do { broken <- checkBrokenTablesNextToCode' dflags
       ; when broken
510
         $ do { _ <- liftIO $ throwIO $ mkApiErr dflags invalidLdErr
511 512 513
              ; fail "unsupported linker"
              }
       }
514 515 516 517
  where
    invalidLdErr = text "Tables-next-to-code not supported on ARM" <+>
                   text "when using binutils ld (please see:" <+>
                   text "https://sourceware.org/bugzilla/show_bug.cgi?id=16177)"
518 519 520 521 522 523 524 525 526 527 528 529 530 531

checkBrokenTablesNextToCode' :: MonadIO m => DynFlags -> m Bool
checkBrokenTablesNextToCode' dflags
  | not (isARM arch)              = return False
  | WayDyn `notElem` ways dflags  = return False
  | not (tablesNextToCode dflags) = return False
  | otherwise                     = do
    linkerInfo <- liftIO $ getLinkerInfo dflags
    case linkerInfo of
      GnuLD _  -> return True
      _        -> return False
  where platform = targetPlatform dflags
        arch = platformArch platform

532 533

-- %************************************************************************
dterei's avatar
dterei committed
534
-- %*                                                                      *
535
--             Flags & settings
dterei's avatar
dterei committed
536
-- %*                                                                      *
537
-- %************************************************************************
538

539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565
-- $DynFlags
--
-- The GHC session maintains two sets of 'DynFlags':
--
--   * The "interactive" @DynFlags@, which are used for everything
--     related to interactive evaluation, including 'runStmt',
--     'runDecls', 'exprType', 'lookupName' and so on (everything
--     under \"Interactive evaluation\" in this module).
--
--   * The "program" @DynFlags@, which are used when loading
--     whole modules with 'load'
--
-- 'setInteractiveDynFlags', 'getInteractiveDynFlags' work with the
-- interactive @DynFlags@.
--
-- 'setProgramDynFlags', 'getProgramDynFlags' work with the
-- program @DynFlags@.
--
-- 'setSessionDynFlags' sets both @DynFlags@, and 'getSessionDynFlags'
-- retrieves the program @DynFlags@ (for backwards compatibility).


-- | Updates both the interactive and program DynFlags in a Session.
-- This also reads the package database (unless it has already been
-- read), and prepares the compilers knowledge about packages.  It can
-- be called again to load new packages: just add new package flags to
-- (packageFlags dflags).
566 567 568 569 570 571
--
-- Returns a list of new packages that may need to be linked in using
-- the dynamic linker (see 'linkPackages') as a result of new package
-- flags.  If you are not doing linking or doing static linking, you
-- can ignore the list of packages returned.
--
572
setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageKey]
573
setSessionDynFlags dflags = do
574 575 576 577
  dflags' <- checkNewDynFlags dflags
  (dflags'', preload) <- liftIO $ initPackages dflags'
  modifySession $ \h -> h{ hsc_dflags = dflags''
                         , hsc_IC = (hsc_IC h){ ic_dflags = dflags'' } }
578
  invalidateModSummaryCache
579 580 581
  return preload

-- | Sets the program 'DynFlags'.
582
setProgramDynFlags :: GhcMonad m => DynFlags -> m [PackageKey]
583
setProgramDynFlags dflags = do
584 585 586
  dflags' <- checkNewDynFlags dflags
  (dflags'', preload) <- liftIO $ initPackages dflags'
  modifySession $ \h -> h{ hsc_dflags = dflags'' }
587
  invalidateModSummaryCache
588
  return preload
589

590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614
-- When changing the DynFlags, we want the changes to apply to future
-- loads, but without completely discarding the program.  But the
-- DynFlags are cached in each ModSummary in the hsc_mod_graph, so
-- after a change to DynFlags, the changes would apply to new modules
-- but not existing modules; this seems undesirable.
--
-- Furthermore, the GHC API client might expect that changing
-- log_action would affect future compilation messages, but for those
-- modules we have cached ModSummaries for, we'll continue to use the
-- old log_action.  This is definitely wrong (#7478).
--
-- Hence, we invalidate the ModSummary cache after changing the
-- DynFlags.  We do this by tweaking the date on each ModSummary, so
-- that the next downsweep will think that all the files have changed
-- and preprocess them again.  This won't necessarily cause everything
-- to be recompiled, because by the time we check whether we need to
-- recopmile a module, we'll have re-summarised the module and have a
-- correct ModSummary.
--
invalidateModSummaryCache :: GhcMonad m => m ()
invalidateModSummaryCache =
  modifySession $ \h -> h { hsc_mod_graph = map inval (hsc_mod_graph h) }
 where
  inval ms = ms { ms_hs_date = addUTCTime (-1) (ms_hs_date ms) }

615 616 617 618 619 620 621 622 623 624
-- | Returns the program 'DynFlags'.
getProgramDynFlags :: GhcMonad m => m DynFlags
getProgramDynFlags = getSessionDynFlags

-- | Set the 'DynFlags' used to evaluate interactive expressions.
-- Note: this cannot be used for changes to packages.  Use
-- 'setSessionDynFlags', or 'setProgramDynFlags' and then copy the
-- 'pkgState' into the interactive @DynFlags@.
setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
setInteractiveDynFlags dflags = do
625 626
  dflags' <- checkNewDynFlags dflags
  modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags' }}
627 628 629 630 631

-- | Get the 'DynFlags' used to evaluate interactive expressions.
getInteractiveDynFlags :: GhcMonad m => m DynFlags
getInteractiveDynFlags = withSession $ \h -> return (ic_dflags (hsc_IC h))

632

633
parseDynamicFlags :: MonadIO m =>
634 635 636 637
                     DynFlags -> [Located String]
                  -> m (DynFlags, [Located String], [Located String])
parseDynamicFlags = parseDynamicFlagsCmdLine

638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663
{- Note [GHCi and -O]
~~~~~~~~~~~~~~~~~~~~~
When using optimization, the compiler can introduce several things
(such as unboxed tuples) into the intermediate code, which GHCi later
chokes on since the bytecode interpreter can't handle this (and while
this is arguably a bug these aren't handled, there are no plans to fix
it.)

While the driver pipeline always checks for this particular erroneous
combination when parsing flags, we also need to check when we update
the flags; this is because API clients may parse flags but update the
DynFlags afterwords, before finally running code inside a session (see
T10052 and #10052).
-}

-- | Checks the set of new DynFlags for possibly erroneous option
-- combinations when invoking 'setSessionDynFlags' and friends, and if
-- found, returns a fixed copy (if possible).
checkNewDynFlags :: MonadIO m => DynFlags -> m DynFlags
checkNewDynFlags dflags
  -- See Note [GHCi and -O]
  | Left e <- checkOptLevel (optLevel dflags) dflags
    = do liftIO $ warningMsg dflags (text e)
         return (dflags { optLevel = 0 })
  | otherwise
    = return dflags
664 665

-- %************************************************************************
dterei's avatar
dterei committed
666
-- %*                                                                      *
667
--             Setting, getting, and modifying the targets
dterei's avatar
dterei committed
668
-- %*                                                                      *
669
-- %************************************************************************
670 671 672 673 674 675

-- ToDo: think about relative vs. absolute file paths. And what
-- happens when the current directory changes.

-- | Sets the targets for this session.  Each target may be a module name
-- or a filename.  The targets correspond to the set of root modules for
676
-- the program\/library.  Unloading the current program is achieved by
677 678 679
-- setting the current set of targets to be empty, followed by 'load'.
setTargets :: GhcMonad m => [Target] -> m ()
setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
680

681 682 683
-- | Returns the current set of targets
getTargets :: GhcMonad m => m [Target]
getTargets = withSession (return . hsc_targets)
684

685 686 687 688
-- | Add another target.
addTarget :: GhcMonad m => Target -> m ()
addTarget target
  = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
689

690
-- | Remove a target
691 692 693
removeTarget :: GhcMonad m => TargetId -> m ()
removeTarget target_id
  = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
694
  where
Simon Marlow's avatar
Simon Marlow committed
695
   filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
696

697 698 699 700 701 702 703 704
-- | Attempts to guess what Target a string refers to.  This function
-- implements the @--make@/GHCi command-line syntax for filenames:
--
--   - if the string looks like a Haskell source filename, then interpret it
--     as such
--
--   - if adding a .hs or .lhs suffix yields the name of an existing file,
--     then use that
705
--
706
--   - otherwise interpret the string as a module name
707
--
708
guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
Simon Marlow's avatar
Simon Marlow committed
709 710 711
guessTarget str (Just phase)
   = return (Target (TargetFile str (Just phase)) True Nothing)
guessTarget str Nothing
712
   | isHaskellSrcFilename file
Simon Marlow's avatar
Simon Marlow committed
713
   = return (target (TargetFile file Nothing))
714
   | otherwise
715
   = do exists <- liftIO $ doesFileExist hs_file
dterei's avatar
dterei committed
716 717 718 719 720 721 722
        if exists
           then return (target (TargetFile hs_file Nothing))
           else do
        exists <- liftIO $ doesFileExist lhs_file
        if exists
           then return (target (TargetFile lhs_file Nothing))
           else do
Simon Marlow's avatar
Simon Marlow committed
723 724 725
        if looksLikeModuleName file
           then return (target (TargetModule (mkModuleName file)))
           else do
Ian Lynagh's avatar
Ian Lynagh committed
726
        dflags <- getDynFlags
727
        liftIO $ throwGhcExceptionIO
Ian Lynagh's avatar
Ian Lynagh committed
728
                 (ProgramError (showSDoc dflags $
Simon Marlow's avatar
Simon Marlow committed
729 730
                 text "target" <+> quotes (text file) <+> 
                 text "is not a module name or a source file"))
731
     where 
Simon Marlow's avatar
Simon Marlow committed
732 733 734 735
         (file,obj_allowed)
                | '*':rest <- str = (rest, False)
                | otherwise       = (str,  True)

dterei's avatar
dterei committed
736 737
         hs_file  = file <.> "hs"
         lhs_file = file <.> "lhs"
738

Simon Marlow's avatar
Simon Marlow committed
739 740
         target tid = Target tid obj_allowed Nothing

741

742 743 744 745 746 747 748 749 750
-- | Inform GHC that the working directory has changed.  GHC will flush
-- its cache of module locations, since it may no longer be valid.
-- 
-- Note: Before changing the working directory make sure all threads running
-- in the same session have stopped.  If you change the working directory,
-- you should also unload the current program (set targets to empty,
-- followed by load).
workingDirectoryChanged :: GhcMonad m => m ()
workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
751

752 753

-- %************************************************************************
dterei's avatar
dterei committed
754
-- %*                                                                      *
755
--             Running phases one at a time
dterei's avatar
dterei committed
756
-- %*                                                                      *
757
-- %************************************************************************
758 759 760 761 762 763 764 765 766 767

class ParsedMod m where
  modSummary   :: m -> ModSummary
  parsedSource :: m -> ParsedSource

class ParsedMod m => TypecheckedMod m where
  renamedSource     :: m -> Maybe RenamedSource
  typecheckedSource :: m -> TypecheckedSource
  moduleInfo        :: m -> ModuleInfo
  tm_internals      :: m -> (TcGblEnv, ModDetails)
dterei's avatar
dterei committed
768 769 770 771 772
        -- ToDo: improvements that could be made here:
        --  if the module succeeded renaming but not typechecking,
        --  we can still get back the GlobalRdrEnv and exports, so
        --  perhaps the ModuleInfo should be split up into separate
        --  fields.
773 774 775 776 777 778 779

class TypecheckedMod m => DesugaredMod m where
  coreModule :: m -> ModGuts

-- | The result of successful parsing.
data ParsedModule =
  ParsedModule { pm_mod_summary   :: ModSummary
780
               , pm_parsed_source :: ParsedSource
Alan Zimmerman's avatar
Alan Zimmerman committed
781 782 783
               , pm_extra_src_files :: [FilePath]
               , pm_annotations :: ApiAnns }
               -- See Note [Api annotations] in ApiAnnotation.hs
784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805

instance ParsedMod ParsedModule where
  modSummary m    = pm_mod_summary m
  parsedSource m = pm_parsed_source m

-- | The result of successful typechecking.  It also contains the parser
--   result.
data TypecheckedModule =
  TypecheckedModule { tm_parsed_module       :: ParsedModule
                    , tm_renamed_source      :: Maybe RenamedSource
                    , tm_typechecked_source  :: TypecheckedSource
                    , tm_checked_module_info :: ModuleInfo
                    , tm_internals_          :: (TcGblEnv, ModDetails)
                    }

instance ParsedMod TypecheckedModule where
  modSummary m   = modSummary (tm_parsed_module m)
  parsedSource m = parsedSource (tm_parsed_module m)

instance TypecheckedMod TypecheckedModule where
  renamedSource m     = tm_renamed_source m
  typecheckedSource m = tm_typechecked_source m
806
  moduleInfo m        = tm_checked_module_info m
807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827
  tm_internals m      = tm_internals_ m

-- | The result of successful desugaring (i.e., translation to core).  Also
--  contains all the information of a typechecked module.
data DesugaredModule =
  DesugaredModule { dm_typechecked_module :: TypecheckedModule
                  , dm_core_module        :: ModGuts
             }

instance ParsedMod DesugaredModule where
  modSummary m   = modSummary (dm_typechecked_module m)
  parsedSource m = parsedSource (dm_typechecked_module m)

instance TypecheckedMod DesugaredModule where
  renamedSource m     = renamedSource (dm_typechecked_module m)
  typecheckedSource m = typecheckedSource (dm_typechecked_module m)
  moduleInfo m        = moduleInfo (dm_typechecked_module m)
  tm_internals m      = tm_internals_ (dm_typechecked_module m)

instance DesugaredMod DesugaredModule where
  coreModule m = dm_core_module m
828

829
type ParsedSource      = Located (HsModule RdrName)
830
type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
831
                          Maybe LHsDocString)
832 833
type TypecheckedSource = LHsBinds Id

834 835 836 837 838 839 840 841 842 843 844 845
-- NOTE:
--   - things that aren't in the output of the typechecker right now:
--     - the export list
--     - the imports
--     - type signatures
--     - type/data/newtype declarations
--     - class declarations
--     - instances
--   - extra things in the typechecker's output:
--     - default methods are turned into top-level decls.
--     - dictionary bindings

846 847 848
-- | Return the 'ModSummary' of a module with the given name.
--
-- The module must be part of the module graph (see 'hsc_mod_graph' and
849
-- 'ModuleGraph').  If this is not the case, this function will throw a
850 851
-- 'GhcApiError'.
--
852 853
-- This function ignores boot modules and requires that there is only one
-- non-boot module with the given name.
854 855 856
getModSummary :: GhcMonad m => ModuleName -> m ModSummary
getModSummary mod = do
   mg <- liftM hsc_mod_graph getSession
857
   case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
858
     [] -> do dflags <- getDynFlags
859
              liftIO $ throwIO $ mkApiErr dflags (text "Module not part of module graph")
860
     [ms] -> return ms
861
     multiple -> do dflags <- getDynFlags
862
                    liftIO $ throwIO $ mkApiErr dflags (text "getModSummary is ambiguous: " <+> ppr multiple)
863 864 865 866

-- | Parse a module.
--
-- Throws a 'SourceError' on parse error.
867 868
parseModule :: GhcMonad m => ModSummary -> m ParsedModule
parseModule ms = do
869 870
   hsc_env <- getSession
   let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
871
   hpm <- liftIO $ hscParse hsc_env_tmp ms
Alan Zimmerman's avatar
Alan Zimmerman committed
872 873 874
   return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm)
                           (hpm_annotations hpm))
               -- See Note [Api annotations] in ApiAnnotation.hs
875 876 877 878 879 880

-- | Typecheck and rename a parsed module.
--
-- Throws a 'SourceError' if either fails.
typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
typecheckModule pmod = do
Thomas Schilling's avatar
Thomas Schilling committed
881
 let ms = modSummary pmod
882 883 884
 hsc_env <- getSession
 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 (tc_gbl_env, rn_info)
885 886
       <- liftIO $ hscTypecheckRename hsc_env_tmp ms $
                      HsParsedModule { hpm_module = parsedSource pmod,
Alan Zimmerman's avatar
Alan Zimmerman committed
887 888
                                       hpm_src_files = pm_extra_src_files pmod,
                                       hpm_annotations = pm_annotations pmod }
889
 details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
890
 safe    <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env
891