GHC.hs 59.1 KB
Newer Older
1
{-# LANGUAGE CPP, NondecreasingIndentation, ScopedTypeVariables #-}
duog's avatar
duog committed
2
{-# LANGUAGE TupleSections, NamedFieldPuns #-}
3 4
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
5

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

module GHC (
dterei's avatar
dterei committed
15 16 17
        -- * Initialisation
        defaultErrorHandler,
        defaultCleanupHandler,
Ian Lynagh's avatar
Ian Lynagh committed
18
        prettyPrintGhcErrors,
Sylvain HENRY's avatar
Sylvain HENRY committed
19
        withSignalHandlers,
20
        withCleanupSession,
21 22

        -- * GHC Monad
Simon Marlow's avatar
Simon Marlow committed
23
        Ghc, GhcT, GhcMonad(..), HscEnv,
24 25
        runGhc, runGhcT, initGhcMonad,
        gcatch, gbracket, gfinally,
26 27
        printException,
        handleSourceError,
28
        needsTemplateHaskellOrQQ,
29

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

        -- * Targets
        Target(..), TargetId(..), Phase,
        setTargets,
        getTargets,
        addTarget,
        removeTarget,
        guessTarget,
45

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

        -- ** Compiling to Core
        CoreModule(..),
61
        compileToCoreModule, compileToCoreSimplified,
62

dterei's avatar
dterei committed
63
        -- * Inspecting the module structure of the program
64 65
        ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
        mgLookupModule,
66
        ModSummary(..), ms_mod_name, ModLocation(..),
Simon Marlow's avatar
Simon Marlow committed
67 68
        getModSummary,
        getModuleGraph,
dterei's avatar
dterei committed
69 70 71 72 73 74 75 76
        isLoaded,
        topSortModuleGraph,

        -- * Inspecting modules
        ModuleInfo,
        getModuleInfo,
        modInfoTyThings,
        modInfoTopLevelScope,
77
        modInfoExports,
78
        modInfoExportsWithSelectors,
dterei's avatar
dterei committed
79 80 81
        modInfoInstances,
        modInfoIsExportedName,
        modInfoLookupName,
82
        modInfoIface,
83
        modInfoSafe,
dterei's avatar
dterei committed
84 85
        lookupGlobalName,
        findGlobalAnns,
86
        mkPrintUnqualifiedForModule,
87
        ModIface(..),
88
        SafeHaskellMode(..),
89

90
        -- * Querying the environment
91
        -- packageDbModules,
92

dterei's avatar
dterei committed
93 94
        -- * Printing
        PrintUnqualified, alwaysQualify,
95

dterei's avatar
dterei committed
96
        -- * Interactive evaluation
97 98

        -- ** Executing statements
99
        execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..),
100 101 102
        resumeExec,

        -- ** Adding new declarations
103
        runDecls, runDeclsWithLocation, runParsedDecls,
104 105 106 107

        -- ** Get/set the current context
        parseImportDecl,
        setContext, getContext,
108
        setGHCiMonad, getGHCiMonad,
109

110
        -- ** Inspecting the current context
dterei's avatar
dterei committed
111
        getBindings, getInsts, getPrintUnqual,
dterei's avatar
dterei committed
112
        findModule, lookupModule,
113
        isModuleTrusted, moduleTrustReqs,
dterei's avatar
dterei committed
114 115
        getNamesInScope,
        getRdrNamesInScope,
116
        getGRE,
dterei's avatar
dterei committed
117 118
        moduleIsInterpreted,
        getInfo,
119
        showModule,
120
        moduleIsBootOrNotObjectLinkable,
duog's avatar
duog committed
121
        getNameToInstancesIndex,
122 123

        -- ** Inspecting types and kinds
124
        exprType, TcRnExprMode(..),
dterei's avatar
dterei committed
125
        typeKind,
126 127

        -- ** Looking up a Name
dterei's avatar
dterei committed
128
        parseName,
129
        lookupName,
130

131
        -- ** Compiling expressions
132 133
        HValue, parseExpr, compileParsedExpr,
        InteractiveEval.compileExpr, dynCompileExpr,
134 135
        ForeignHValue,
        compileExprRemote, compileParsedExprRemote,
136

137 138 139
        -- ** Docs
        getDocs, GetDocsFailure(..),

140
        -- ** Other
141
        runTcInteractive,   -- Desired by some clients (Trac #8878)
142
        isStmt, hasImport, isImport, isDecl,
143 144 145

        -- ** The debugger
        SingleStep(..),
146
        Resume(..),
147
        History(historyBreakInfo, historyEnclosingDecls),
148
        GHC.getHistorySpan, getHistoryModule,
149
        abandon, abandonAll,
150
        getResumeContext,
pepe's avatar
pepe committed
151
        GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
152
        modInfoModBreaks,
153 154
        ModBreaks(..), BreakIndex,
        BreakInfo(breakInfo_number, breakInfo_module),
155 156
        InteractiveEval.back,
        InteractiveEval.forward,
157

dterei's avatar
dterei committed
158
        -- * Abstract syntax elements
159

Simon Marlow's avatar
Simon Marlow committed
160
        -- ** Packages
161
        UnitId,
Simon Marlow's avatar
Simon Marlow committed
162

dterei's avatar
dterei committed
163
        -- ** Modules
164
        Module, mkModule, pprModule, moduleName, moduleUnitId,
Simon Marlow's avatar
Simon Marlow committed
165
        ModuleName, mkModuleName, moduleNameString,
166

dterei's avatar
dterei committed
167
        -- ** Names
168
        Name,
dterei's avatar
dterei committed
169 170 171
        isExternalName, nameModule, pprParenSymName, nameSrcSpan,
        NamedThing(..),
        RdrName(Qual,Unqual),
172

dterei's avatar
dterei committed
173 174 175 176 177 178 179 180
        -- ** Identifiers
        Id, idType,
        isImplicitId, isDeadBinder,
        isExportedId, isLocalId, isGlobalId,
        isRecordSelector,
        isPrimOpId, isFCallId, isClassOpId_maybe,
        isDataConWorkId, idDataCon,
        isBottomingId, isDictonaryId,
181
        recordSelectorTyCon,
dterei's avatar
dterei committed
182 183

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

        -- ** Type variables
        TyVar,
        alphaTyVars,

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

        -- ** Classes
204
        Class,
dterei's avatar
dterei committed
205 206 207 208
        classMethods, classSCTheta, classTvsFds, classATs,
        pprFundeps,

        -- ** Instances
209 210
        ClsInst,
        instanceDFunId,
211
        pprInstance, pprInstanceHdr,
212
        pprFamInst,
213

214
        FamInst,
215

dterei's avatar
dterei committed
216
        -- ** Types and Kinds
217 218
        Type, splitForAllTys, funResultTy,
        pprParendType, pprTypeApp,
dterei's avatar
dterei committed
219 220
        Kind,
        PredType,
Ben Gamari's avatar
Ben Gamari committed
221
        ThetaType, pprForAll, pprThetaArrowTy,
222

dterei's avatar
dterei committed
223
        -- ** Entities
224
        TyThing(..),
225

dterei's avatar
dterei committed
226 227
        -- ** Syntax
        module HsSyn, -- ToDo: remove extraneous bits
228

dterei's avatar
dterei committed
229
        -- ** Fixities
230 231
        FixityDirection(..),
        defaultFixity, maxPrecedence,
dterei's avatar
dterei committed
232 233
        negateFixity,
        compareFixity,
234
        LexicalFixity(..),
235

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

247
        -- ** Located
dterei's avatar
dterei committed
248
        GenLocated(..), Located,
249

dterei's avatar
dterei committed
250 251
        -- *** Constructing Located
        noLoc, mkGeneralLocated,
252

dterei's avatar
dterei committed
253 254
        -- *** Deconstructing Located
        getLoc, unLoc,
255 256 257 258
        getRealSrcSpan, unRealSrcSpan,

        -- ** HasSrcSpan
        HasSrcSpan(..), SrcSpanLess, dL, cL,
259

dterei's avatar
dterei committed
260 261
        -- *** Combining and comparing Located values
        eqLocated, cmpLocated, combineLocs, addCLoc,
262 263 264
        leftmost_smallest, leftmost_largest, rightmost,
        spans, isSubspanOf,

dterei's avatar
dterei committed
265 266
        -- * Exceptions
        GhcException(..), showGhcException,
267

Jedai's avatar
Jedai committed
268 269 270 271 272
        -- * Token stream manipulations
        Token,
        getTokenStream, getRichTokenStream,
        showRichTokenStream, addSourceToTokens,

273 274 275
        -- * Pure interface to the parser
        parser,

Alan Zimmerman's avatar
Alan Zimmerman committed
276 277
        -- * API Annotations
        ApiAnns,AnnKeywordId(..),AnnotationComment(..),
Alan Zimmerman's avatar
Alan Zimmerman committed
278 279
        getAnnotation, getAndRemoveAnnotation,
        getAnnotationComments, getAndRemoveAnnotationComments,
280
        unicodeAnn,
Alan Zimmerman's avatar
Alan Zimmerman committed
281

dterei's avatar
dterei committed
282 283 284
        -- * Miscellaneous
        --sessionHscEnv,
        cyclicModuleErr,
285 286
  ) where

287 288 289
{-
 ToDo:

290
  * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
291 292 293 294
-}

#include "HsVersions.h"

295 296
import GhcPrelude hiding (init)

297
import ByteCodeTypes
298
import InteractiveEval
299
import InteractiveEvalTypes
300 301
import GHCi
import GHCi.RemoteTypes
302

303
import PprTyThing       ( pprFamInst )
304
import HscMain
305
import GhcMake
306
import DriverPipeline   ( compileOne' )
307
import GhcMonad
308 309
import TcRnMonad        ( finalSafeMode, fixSafeInstances, initIfaceTcRn )
import LoadIface        ( loadSysInterface )
310
import TcRnTypes
311 312 313
import Packages
import NameSet
import RdrName
314
import HsSyn
batterseapower's avatar
batterseapower committed
315
import Type     hiding( typeKind )
Simon Peyton Jones's avatar
Simon Peyton Jones committed
316
import TcType
317
import Id
dterei's avatar
dterei committed
318
import TysPrim          ( alphaTyVars )
319 320 321 322
import TyCon
import Class
import DataCon
import Name             hiding ( varName )
323
import Avail
324
import InstEnv
325
import FamInstEnv ( FamInst )
326
import SrcLoc
327
import CoreSyn
328
import TidyPgm
329
import DriverPhases     ( Phase(..), isHaskellSrcFilename )
330 331
import Finder
import HscTypes
332 333
import CmdLineParser
import DynFlags hiding (WarnReason(..))
334
import SysTools
335
import SysTools.BaseDir
336
import Annotations
337 338
import Module
import Panic
339
import Platform
340
import Bag              ( listToBag, unitBag )
341
import ErrUtils
342
import MonadUtils
343
import Util
344
import StringBuffer
345
import Outputable
346
import BasicTypes
dterei's avatar
dterei committed
347
import Maybes           ( expectJust )
348
import FastString
349
import qualified Parser
Jedai's avatar
Jedai committed
350
import Lexer
Alan Zimmerman's avatar
Alan Zimmerman committed
351
import ApiAnnotation
352
import qualified GHC.LanguageExtensions as LangExt
duog's avatar
duog committed
353 354 355 356 357 358
import NameEnv
import CoreFVs          ( orphNamesOfFamInst )
import FamInstEnv       ( famInstEnvElts )
import TcRnDriver
import Inst
import FamInst
duog's avatar
duog committed
359
import FileCleanup
360

duog's avatar
duog committed
361 362
import Data.Foldable
import qualified Data.Map.Strict as Map
duog's avatar
duog committed
363
import Data.Set (Set)
duog's avatar
duog committed
364
import qualified Data.Sequence as Seq
Austin Seipp's avatar
Austin Seipp committed
365
import System.Directory ( doesFileExist )
366
import Data.Maybe
367
import Data.Time
368 369
import Data.Typeable    ( Typeable )
import Data.Word        ( Word8 )
370
import Control.Monad
dterei's avatar
dterei committed
371
import System.Exit      ( exitWith, ExitCode(..) )
372
import Exception
373
import Data.IORef
Ian Lynagh's avatar
Ian Lynagh committed
374
import System.FilePath
375

376

377
-- %************************************************************************
dterei's avatar
dterei committed
378
-- %*                                                                      *
379
--             Initialisation: exception handlers
dterei's avatar
dterei committed
380
-- %*                                                                      *
381 382
-- %************************************************************************

383 384 385 386 387

-- | 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.
388
defaultErrorHandler :: (ExceptionMonad m)
Ian Lynagh's avatar
Ian Lynagh committed
389 390
                    => FatalMessager -> FlushOut -> m a -> m a
defaultErrorHandler fm (FlushOut flushOut) inner =
391
  -- top-level exception handler: any unrecognised exception is a compiler bug.
392
  ghandle (\exception -> liftIO $ do
393
           flushOut
394
           case fromException exception of
395 396
                -- an IO exception probably isn't our fault, so don't panic
                Just (ioe :: IOException) ->
Ian Lynagh's avatar
Ian Lynagh committed
397
                  fatalErrorMsg'' fm (show ioe)
398
                _ -> case fromException exception of
399 400 401 402
                     Just UserInterrupt ->
                         -- Important to let this one propagate out so our
                         -- calling process knows we were interrupted by ^C
                         liftIO $ throwIO UserInterrupt
403
                     Just StackOverflow ->
Ian Lynagh's avatar
Ian Lynagh committed
404
                         fatalErrorMsg'' fm "stack overflow: use +RTS -K<size> to increase it"
405
                     _ -> case fromException exception of
406
                          Just (ex :: ExitCode) -> liftIO $ throwIO ex
407
                          _ ->
Ian Lynagh's avatar
Ian Lynagh committed
408 409
                              fatalErrorMsg'' fm
                                  (show (Panic (show exception)))
410
           exitWith (ExitFailure 1)
411 412
         ) $

413
  -- error messages propagated as exceptions
414
  handleGhcException
415
            (\ge -> liftIO $ do
416
                flushOut
dterei's avatar
dterei committed
417 418
                case ge of
                     Signal _ -> exitWith (ExitFailure 1)
Ian Lynagh's avatar
Ian Lynagh committed
419
                     _ -> do fatalErrorMsg'' fm (show ge)
dterei's avatar
dterei committed
420 421
                             exitWith (ExitFailure 1)
            ) $
422 423
  inner

424 425 426 427 428 429
-- | This function is no longer necessary, cleanup is now done by
-- runGhc/runGhcT.
{-# DEPRECATED defaultCleanupHandler "Cleanup is now done by runGhc/runGhcT" #-}
defaultCleanupHandler :: (ExceptionMonad m) => DynFlags -> m a -> m a
defaultCleanupHandler _ m = m
 where _warning_suppression = m `gonException` undefined
430

431

432
-- %************************************************************************
dterei's avatar
dterei committed
433
-- %*                                                                      *
434
--             The Ghc Monad
dterei's avatar
dterei committed
435
-- %*                                                                      *
436
-- %************************************************************************
437 438 439 440 441 442 443 444 445 446 447 448 449 450

-- | 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
451
  ref <- newIORef (panic "empty session")
452
  let session = Session ref
Sylvain HENRY's avatar
Sylvain HENRY committed
453
  flip unGhc session $ withSignalHandlers $ do -- catch ^C
454
    initGhcMonad mb_top_dir
455 456
    withCleanupSession ghc

457 458 459 460 461 462
-- | 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.

463
runGhcT :: ExceptionMonad m =>
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
Sylvain HENRY's avatar
Sylvain HENRY committed
470
  flip unGhcT session $ withSignalHandlers $ do -- catch ^C
471
    initGhcMonad mb_top_dir
472 473 474 475 476 477 478 479 480 481 482 483 484 485 486
    withCleanupSession ghct

withCleanupSession :: GhcMonad m => m a -> m a
withCleanupSession ghc = ghc `gfinally` cleanup
  where
   cleanup = do
      hsc_env <- getSession
      let dflags = hsc_dflags hsc_env
      liftIO $ do
          cleanTempFiles dflags
          cleanTempDirs dflags
          stopIServ hsc_env -- shut down the IServ
          --  exceptions will be blocked while we clean the temporary files,
          -- so there shouldn't be any difficulty if we receive further
          -- signals.
487 488 489 490 491 492 493 494 495 496 497

-- | 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
498
-- <http://hackage.haskell.org/package/ghc-paths>.
499 500

initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
501 502
initGhcMonad mb_top_dir
  = do { env <- liftIO $
503 504 505
                do { top_dir <- findTopDir mb_top_dir
                   ; mySettings <- initSysTools top_dir
                   ; myLlvmConfig <- initLlvmConfig top_dir
506
                   ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig)
507
                   ; checkBrokenTablesNextToCode dflags
508 509 510 511 512
                   ; setUnsafeGlobalDynFlags dflags
                      -- c.f. DynFlags.parseDynamicFlagsFull, which
                      -- creates DynFlags and sets the UnsafeGlobalDynFlags
                   ; newHscEnv dflags }
       ; setSession env }
513

514 515 516 517 518 519 520 521 522 523
-- | 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
524
         $ do { _ <- liftIO $ throwIO $ mkApiErr dflags invalidLdErr
525
              ; liftIO $ fail "unsupported linker"
526 527
              }
       }
528 529 530 531
  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)"
532 533 534 535 536 537 538 539 540 541 542 543 544 545

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

546 547

-- %************************************************************************
dterei's avatar
dterei committed
548
-- %*                                                                      *
549
--             Flags & settings
dterei's avatar
dterei committed
550
-- %*                                                                      *
551
-- %************************************************************************
552

553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579
-- $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).
580 581 582 583 584 585
--
-- 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.
--
586
setSessionDynFlags :: GhcMonad m => DynFlags -> m [InstalledUnitId]
587
setSessionDynFlags dflags = do
588 589 590 591
  dflags' <- checkNewDynFlags dflags
  (dflags'', preload) <- liftIO $ initPackages dflags'
  modifySession $ \h -> h{ hsc_dflags = dflags''
                         , hsc_IC = (hsc_IC h){ ic_dflags = dflags'' } }
592
  invalidateModSummaryCache
593 594
  return preload

595 596 597
-- | Sets the program 'DynFlags'.  Note: this invalidates the internal
-- cached module graph, causing more work to be done the next time
-- 'load' is called.
598
setProgramDynFlags :: GhcMonad m => DynFlags -> m [InstalledUnitId]
599 600 601 602 603
setProgramDynFlags dflags = setProgramDynFlags_ True dflags

-- | Set the action taken when the compiler produces a message.  This
-- can also be accomplished using 'setProgramDynFlags', but using
-- 'setLogAction' avoids invalidating the cached module graph.
604 605
setLogAction :: GhcMonad m => LogAction -> m ()
setLogAction action = do
606 607
  dflags' <- getProgramDynFlags
  void $ setProgramDynFlags_ False $
608
    dflags' { log_action = action }
609 610 611

setProgramDynFlags_ :: GhcMonad m => Bool -> DynFlags -> m [InstalledUnitId]
setProgramDynFlags_ invalidate_needed dflags = do
612
  dflags' <- checkNewDynFlags dflags
613 614 615 616 617
  dflags_prev <- getProgramDynFlags
  (dflags'', preload) <-
    if (packageFlagsChanged dflags_prev dflags')
       then liftIO $ initPackages dflags'
       else return (dflags', [])
618
  modifySession $ \h -> h{ hsc_dflags = dflags'' }
619
  when invalidate_needed $ invalidateModSummaryCache
620
  return preload
621

622

623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643
-- 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 =
644
  modifySession $ \h -> h { hsc_mod_graph = mapMG inval (hsc_mod_graph h) }
645 646 647
 where
  inval ms = ms { ms_hs_date = addUTCTime (-1) (ms_hs_date ms) }

648 649 650 651 652 653 654 655 656 657
-- | 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
658
  dflags' <- checkNewDynFlags dflags
659 660
  dflags'' <- checkNewInteractiveDynFlags dflags'
  modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags'' }}
661 662 663 664 665

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

666

667
parseDynamicFlags :: MonadIO m =>
668
                     DynFlags -> [Located String]
669
                  -> m (DynFlags, [Located String], [Warn])
670 671
parseDynamicFlags = parseDynamicFlagsCmdLine

672 673 674 675
-- | 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
Ben Gamari's avatar
Ben Gamari committed
676 677 678
checkNewDynFlags dflags = do
  -- See Note [DynFlags consistency]
  let (dflags', warnings) = makeDynFlagsConsistent dflags
679
  liftIO $ handleFlagWarnings dflags (map (Warn NoReason) warnings)
Ben Gamari's avatar
Ben Gamari committed
680
  return dflags'
681

682 683
checkNewInteractiveDynFlags :: MonadIO m => DynFlags -> m DynFlags
checkNewInteractiveDynFlags dflags0 = do
684 685 686 687 688 689 690 691 692 693
  -- We currently don't support use of StaticPointers in expressions entered on
  -- the REPL. See #12356.
  dflags1 <-
      if xopt LangExt.StaticPointers dflags0
      then do liftIO $ printOrThrowWarnings dflags0 $ listToBag
                [mkPlainWarnMsg dflags0 interactiveSrcSpan
                 $ text "StaticPointers is not supported in GHCi interactive expressions."]
              return $ xopt_unset dflags0 LangExt.StaticPointers
      else return dflags0
  return dflags1
694 695


696
-- %************************************************************************
dterei's avatar
dterei committed
697
-- %*                                                                      *
698
--             Setting, getting, and modifying the targets
dterei's avatar
dterei committed
699
-- %*                                                                      *
700
-- %************************************************************************
701 702 703 704 705 706

-- 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
707
-- the program\/library.  Unloading the current program is achieved by
708 709 710
-- 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 })
711

712 713 714
-- | Returns the current set of targets
getTargets :: GhcMonad m => m [Target]
getTargets = withSession (return . hsc_targets)
715

716 717 718 719
-- | Add another target.
addTarget :: GhcMonad m => Target -> m ()
addTarget target
  = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
720

721
-- | Remove a target
722 723 724
removeTarget :: GhcMonad m => TargetId -> m ()
removeTarget target_id
  = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
725
  where
Simon Marlow's avatar
Simon Marlow committed
726
   filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
727

728 729 730 731 732 733 734 735
-- | 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
736
--
737
--   - otherwise interpret the string as a module name
738
--
739
guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
Simon Marlow's avatar
Simon Marlow committed
740 741 742
guessTarget str (Just phase)
   = return (Target (TargetFile str (Just phase)) True Nothing)
guessTarget str Nothing
743
   | isHaskellSrcFilename file
Simon Marlow's avatar
Simon Marlow committed
744
   = return (target (TargetFile file Nothing))
745
   | otherwise
746
   = do exists <- liftIO $ doesFileExist hs_file
dterei's avatar
dterei committed
747 748 749 750 751 752 753
        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
754 755 756
        if looksLikeModuleName file
           then return (target (TargetModule (mkModuleName file)))
           else do
Ian Lynagh's avatar
Ian Lynagh committed
757
        dflags <- getDynFlags
758
        liftIO $ throwGhcExceptionIO
Ian Lynagh's avatar
Ian Lynagh committed
759
                 (ProgramError (showSDoc dflags $
760
                 text "target" <+> quotes (text file) <+>
761
                 text "is not a module name or a source file"))
762
     where
Simon Marlow's avatar
Simon Marlow committed
763 764 765 766
         (file,obj_allowed)
                | '*':rest <- str = (rest, False)
                | otherwise       = (str,  True)

dterei's avatar
dterei committed
767 768
         hs_file  = file <.> "hs"
         lhs_file = file <.> "lhs"
769

Simon Marlow's avatar
Simon Marlow committed
770 771
         target tid = Target tid obj_allowed Nothing

772

773 774
-- | Inform GHC that the working directory has changed.  GHC will flush
-- its cache of module locations, since it may no longer be valid.
775
--
776 777 778 779 780 781
-- 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)
782

783 784

-- %************************************************************************
dterei's avatar
dterei committed
785
-- %*                                                                      *
786
--             Running phases one at a time
dterei's avatar
dterei committed
787
-- %*                                                                      *
788
-- %************************************************************************
789 790 791 792 793 794 795 796 797 798

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
799 800 801 802 803
        -- 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.
804 805 806 807 808 809 810

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

-- | The result of successful parsing.
data ParsedModule =
  ParsedModule { pm_mod_summary   :: ModSummary
811
               , pm_parsed_source :: ParsedSource
Alan Zimmerman's avatar
Alan Zimmerman committed
812 813 814
               , pm_extra_src_files :: [FilePath]
               , pm_annotations :: ApiAnns }
               -- See Note [Api annotations] in ApiAnnotation.hs
815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836

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
837
  moduleInfo m        = tm_checked_module_info m
838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858
  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
859

860
type ParsedSource      = Located (HsModule GhcPs)
861
type RenamedSource     = (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],
862
                          Maybe LHsDocString)
863
type TypecheckedSource = LHsBinds GhcTc
864

865 866 867 868 869 870 871 872 873 874 875 876
-- 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

877 878 879
-- | Return the 'ModSummary' of a module with the given name.
--
-- The module must be part of the module graph (see 'hsc_mod_graph' and
880
-- 'ModuleGraph').  If this is not the case, this function will throw a
881 882
-- 'GhcApiError'.
--
883 884
-- This function ignores boot modules and requires that there is only one
-- non-boot module with the given name.
885 886 887
getModSummary :: GhcMonad m => ModuleName -> m ModSummary
getModSummary mod = do
   mg <- liftM hsc_mod_graph getSession
888 889 890 891
   let mods_by_name = [ ms | ms <- mgModSummaries mg
                      , ms_mod_name ms == mod
                      , not (isBootSummary ms) ]
   case mods_by_name of
892
     [] -> do dflags <- getDynFlags
893
              liftIO $ throwIO $ mkApiErr dflags (text "Module not part of module graph")
894
     [ms] -> return ms
895
     multiple -> do dflags <- getDynFlags
896
                    liftIO $ throwIO $ mkApiErr dflags (text "getModSummary is ambiguous: " <+> ppr multiple)
897 898 899 900

-- | Parse a module.
--
-- Throws a 'SourceError' on parse error.
901 902
parseModule :: GhcMonad m => ModSummary -> m ParsedModule
parseModule ms = do
903 904
   hsc_env <- getSession
   let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
905
   hpm <- liftIO $ hscParse hsc_env_tmp ms
Alan Zimmerman's avatar
Alan Zimmerman committed
906 907 908
   return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm)
                           (hpm_annotations hpm))
               -- See Note [Api annotations] in ApiAnnotation.hs
909 910 911 912 913 914

-- | Typecheck and rename a parsed module.
--
-- Throws a 'SourceError' if either fails.
typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
typecheckModule pmod = do
915
 let ms = modSummary pmod
916 917 918
 hsc_env <- getSession
 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 (tc_gbl_env, rn_info)
919 920
       <- liftIO $ hscTypecheckRename hsc_env_tmp ms $
                      HsParsedModule { hpm_module = parsedSource pmod,
Alan Zimmerman's avatar
Alan Zimmerman committed
921 922
                                       hpm_src_files = pm_extra_src_files pmod,
                                       hpm_annotations = pm_annotations pmod }
923
 details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
924
 safe    <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env
925

926
 return $
927 928 929 930 931 932 933 934
     TypecheckedModule {
       tm_internals_          = (tc_gbl_env, details),
       tm_parsed_module       = pmod,
       tm_renamed_source      = rn_info,
       tm_typechecked_source  = tcg_binds tc_gbl_env,
       tm_checked_module_info =
         ModuleInfo {
           minf_type_env  = md_types details,
935
           minf_exports   = md_exports details,
936
           minf_rdr_env   = Just (tcg_rdr_env tc_gbl_env),
937
           minf_instances = fixSafeInstances safe $ md_insts details,
938
           minf_iface     = Nothing,
939 940
           minf_safe      = safe,
           minf_modBreaks = emptyModBreaks
941 942 943 944 945
         }}

-- | Desugar a typechecked module.
desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
desugarModule tcm = do
946
 let ms = modSummary tcm
947 948 949 950 951
 let (tcg, _) = tm_internals tcm
 hsc_env <- getSession
 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg
 return $
952 953 954 955 956 957 958
     DesugaredModule {
       dm_typechecked_module = tcm,
       dm_core_module        = guts
     }

-- | Load a module.  Input doesn't need to be desugared.
--
Thomas Schilling's avatar
Thomas Schilling committed
959 960 961 962 963 964 965
-- A module must be loaded before dependent modules can be typechecked.  This
-- always includes generating a 'ModIface' and, depending on the
-- 'DynFlags.hscTarget', may also include code generation.
--
-- This function will always cause recompilation and will always overwrite
-- previous compilation results (potentially files on disk).
--
966 967 968 969
loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
loadModule tcm = do
   let ms = modSummary tcm
   let mod = ms_mod_name ms
970
   let loc = ms_location ms
971 972
   let (tcg, _details) = tm_internals tcm

973
   mb_linkable <- case ms_obj_date ms of
974
                     Just t | t > ms_hs_date ms  -> do
975
                         l <- liftIO $ findObjectLinkable (ms_mod ms)
976 977 978
                                                  (ml_obj_file loc) t
                         return (Just l)
                     _otherwise -> return Nothing
979

980 981 982 983
   let source_modified | isNothing mb_linkable = SourceModified
                       | otherwise             = SourceUnmodified
                       -- we can't determine stability here

984 985
   -- compile doesn't change the session
   hsc_env <- getSession
986 987 988
   mod_info <- liftIO $ compileOne' (Just tcg) Nothing
                                    hsc_env ms 1 1 Nothing mb_linkable
                                    source_modified
989

niteria's avatar
niteria committed
990
   modifySession $ \e -> e{ hsc_HPT = addToHpt (hsc_HPT e) mod mod_info }
991
   return tcm
992

993 994

-- %************************************************************************
dterei's avatar
dterei committed
995
-- %*                                                                      *
996
--             Dealing with Core
dterei's avatar
dterei committed
997
-- %*                                                                      *
998
-- %************************************************************************
999 1000 1001 1002 1003 1004 1005 1006 1007 1008

-- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
-- the 'GHC.compileToCoreModule' interface.
data CoreModule
  = CoreModule {
      -- | Module name
      cm_module   :: !Module,
      -- | Type environment for types declared in this module
      cm_types    :: !TypeEnv,
      -- | Declarations
1009 1010 1011
      cm_binds    :: CoreProgram,
      -- | Safe Haskell mode
      cm_safe     :: SafeHaskellMode
1012 1013 1014
    }

instance Outputable CoreModule where
1015 1016 1017 1018
   ppr (CoreModule {cm_module