GHC.hs 63.8 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,
37
        interpretPackageEnv,
dterei's avatar
dterei committed
38 39 40 41 42 43 44 45

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

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

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

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

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

92
        -- * Querying the environment
93
        -- packageDbModules,
94

dterei's avatar
dterei committed
95 96
        -- * Printing
        PrintUnqualified, alwaysQualify,
97

dterei's avatar
dterei committed
98
        -- * Interactive evaluation
99 100

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

        -- ** Adding new declarations
105
        runDecls, runDeclsWithLocation, runParsedDecls,
106 107 108 109

        -- ** Get/set the current context
        parseImportDecl,
        setContext, getContext,
110
        setGHCiMonad, getGHCiMonad,
111

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

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

        -- ** Looking up a Name
dterei's avatar
dterei committed
130
        parseName,
131
        lookupName,
132

133
        -- ** Compiling expressions
134
        HValue, parseExpr, compileParsedExpr,
135
        GHC.Runtime.Eval.compileExpr, dynCompileExpr,
136 137
        ForeignHValue,
        compileExprRemote, compileParsedExprRemote,
138

139 140 141
        -- ** Docs
        getDocs, GetDocsFailure(..),

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

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

dterei's avatar
dterei committed
160
        -- * Abstract syntax elements
161

Simon Marlow's avatar
Simon Marlow committed
162
        -- ** Packages
163
        UnitId,
Simon Marlow's avatar
Simon Marlow committed
164

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

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

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

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

        -- ** Type variables
        TyVar,
        alphaTyVars,

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

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

        -- ** Instances
211 212
        ClsInst,
        instanceDFunId,
213
        pprInstance, pprInstanceHdr,
214
        pprFamInst,
215

216
        FamInst,
217

dterei's avatar
dterei committed
218
        -- ** Types and Kinds
219 220
        Type, splitForAllTys, funResultTy,
        pprParendType, pprTypeApp,
dterei's avatar
dterei committed
221 222
        Kind,
        PredType,
Ben Gamari's avatar
Ben Gamari committed
223
        ThetaType, pprForAll, pprThetaArrowTy,
xldenis's avatar
xldenis committed
224 225
        parseInstanceHead,
        getInstancesForType,
226

dterei's avatar
dterei committed
227
        -- ** Entities
228
        TyThing(..),
229

dterei's avatar
dterei committed
230
        -- ** Syntax
231
        module GHC.Hs, -- ToDo: remove extraneous bits
232

dterei's avatar
dterei committed
233
        -- ** Fixities
234 235
        FixityDirection(..),
        defaultFixity, maxPrecedence,
dterei's avatar
dterei committed
236 237
        negateFixity,
        compareFixity,
238
        LexicalFixity(..),
239

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

251
        -- ** Located
dterei's avatar
dterei committed
252
        GenLocated(..), Located,
253

dterei's avatar
dterei committed
254 255
        -- *** Constructing Located
        noLoc, mkGeneralLocated,
256

dterei's avatar
dterei committed
257 258
        -- *** Deconstructing Located
        getLoc, unLoc,
259 260
        getRealSrcSpan, unRealSrcSpan,

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

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

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

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

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

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

288 289 290
{-
 ToDo:

Sylvain Henry's avatar
Sylvain Henry committed
291
  * inline bits of GHC.Driver.Main here to simplify layering: hscTcExpr, hscStmt.
292 293 294 295
-}

#include "HsVersions.h"

296 297
import GhcPrelude hiding (init)

298 299 300 301
import GHC.ByteCode.Types
import GHC.Runtime.Eval
import GHC.Runtime.Eval.Types
import GHC.Runtime.Interpreter
302
import GHCi.RemoteTypes
303

304
import PprTyThing       ( pprFamInst )
Sylvain Henry's avatar
Sylvain Henry committed
305 306 307 308
import GHC.Driver.Main
import GHC.Driver.Make
import GHC.Driver.Pipeline   ( compileOne' )
import GHC.Driver.Monad
309
import TcRnMonad        ( finalSafeMode, fixSafeInstances, initIfaceTcRn )
310
import GHC.Iface.Load   ( loadSysInterface )
311
import TcRnTypes
312
import Predicate
Sylvain Henry's avatar
Sylvain Henry committed
313
import GHC.Driver.Packages
314 315
import NameSet
import RdrName
316
import GHC.Hs
batterseapower's avatar
batterseapower committed
317
import Type     hiding( typeKind )
Simon Peyton Jones's avatar
Simon Peyton Jones committed
318
import TcType
319
import Id
dterei's avatar
dterei committed
320
import TysPrim          ( alphaTyVars )
321
import TyCon
322
import TyCoPpr          ( pprForAll )
323 324 325
import Class
import DataCon
import Name             hiding ( varName )
326
import Avail
327
import InstEnv
328
import FamInstEnv ( FamInst )
329
import SrcLoc
330
import CoreSyn
331
import GHC.Iface.Tidy
Sylvain Henry's avatar
Sylvain Henry committed
332 333 334 335 336
import GHC.Driver.Phases     ( Phase(..), isHaskellSrcFilename )
import GHC.Driver.Finder
import GHC.Driver.Types
import GHC.Driver.CmdLine
import GHC.Driver.Session hiding (WarnReason(..))
337
import SysTools
338
import SysTools.BaseDir
339
import Annotations
340 341
import Module
import Panic
John Ericson's avatar
John Ericson committed
342
import GHC.Platform
343
import Bag              ( listToBag )
344
import ErrUtils
345
import MonadUtils
346
import Util
347
import StringBuffer
348
import Outputable
349
import BasicTypes
350
import FastString
351
import qualified Parser
Jedai's avatar
Jedai committed
352
import Lexer
Alan Zimmerman's avatar
Alan Zimmerman committed
353
import ApiAnnotation
354
import qualified GHC.LanguageExtensions as LangExt
duog's avatar
duog committed
355 356 357 358 359 360
import NameEnv
import CoreFVs          ( orphNamesOfFamInst )
import FamInstEnv       ( famInstEnvElts )
import TcRnDriver
import Inst
import FamInst
duog's avatar
duog committed
361
import FileCleanup
362

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

377 378 379 380 381
import Maybes
import System.IO.Error  ( isDoesNotExistError )
import System.Environment ( getEnv )
import System.Directory

382

383
-- %************************************************************************
dterei's avatar
dterei committed
384
-- %*                                                                      *
385
--             Initialisation: exception handlers
dterei's avatar
dterei committed
386
-- %*                                                                      *
387 388
-- %************************************************************************

389 390 391 392 393

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

419
  -- error messages propagated as exceptions
420
  handleGhcException
421
            (\ge -> liftIO $ do
422
                flushOut
dterei's avatar
dterei committed
423 424
                case ge of
                     Signal _ -> exitWith (ExitFailure 1)
Ian Lynagh's avatar
Ian Lynagh committed
425
                     _ -> do fatalErrorMsg'' fm (show ge)
dterei's avatar
dterei committed
426 427
                             exitWith (ExitFailure 1)
            ) $
428 429
  inner

430 431 432 433 434 435
-- | 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
436

437

438
-- %************************************************************************
dterei's avatar
dterei committed
439
-- %*                                                                      *
440
--             The Ghc Monad
dterei's avatar
dterei committed
441
-- %*                                                                      *
442
-- %************************************************************************
443 444 445 446 447 448 449 450 451 452 453 454 455 456

-- | 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
457
  ref <- newIORef (panic "empty session")
458
  let session = Session ref
Sylvain HENRY's avatar
Sylvain HENRY committed
459
  flip unGhc session $ withSignalHandlers $ do -- catch ^C
460
    initGhcMonad mb_top_dir
461 462
    withCleanupSession ghc

463 464 465 466 467 468
-- | 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.

469
runGhcT :: ExceptionMonad m =>
470 471 472 473
           Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
        -> GhcT m a        -- ^ The action to perform.
        -> m a
runGhcT mb_top_dir ghct = do
474
  ref <- liftIO $ newIORef (panic "empty session")
475
  let session = Session ref
Sylvain HENRY's avatar
Sylvain HENRY committed
476
  flip unGhcT session $ withSignalHandlers $ do -- catch ^C
477
    initGhcMonad mb_top_dir
478 479 480 481 482 483 484 485 486 487 488 489 490 491 492
    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.
493 494 495 496 497 498 499 500 501 502 503

-- | 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
504
-- <http://hackage.haskell.org/package/ghc-paths>.
505 506

initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
507 508
initGhcMonad mb_top_dir
  = do { env <- liftIO $
509 510
                do { top_dir <- findTopDir mb_top_dir
                   ; mySettings <- initSysTools top_dir
511
                   ; myLlvmConfig <- lazyInitLlvmConfig top_dir
512
                   ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig)
513
                   ; checkBrokenTablesNextToCode dflags
514 515 516 517 518
                   ; setUnsafeGlobalDynFlags dflags
                      -- c.f. DynFlags.parseDynamicFlagsFull, which
                      -- creates DynFlags and sets the UnsafeGlobalDynFlags
                   ; newHscEnv dflags }
       ; setSession env }
519

520 521 522 523 524
-- | 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
525
-- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333
526 527 528 529
checkBrokenTablesNextToCode :: MonadIO m => DynFlags -> m ()
checkBrokenTablesNextToCode dflags
  = do { broken <- checkBrokenTablesNextToCode' dflags
       ; when broken
530
         $ do { _ <- liftIO $ throwIO $ mkApiErr dflags invalidLdErr
531
              ; liftIO $ fail "unsupported linker"
532 533
              }
       }
534 535 536 537
  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)"
538 539 540 541 542 543 544 545 546 547 548 549 550 551

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

552 553

-- %************************************************************************
dterei's avatar
dterei committed
554
-- %*                                                                      *
555
--             Flags & settings
dterei's avatar
dterei committed
556
-- %*                                                                      *
557
-- %************************************************************************
558

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

602 603 604
-- | Sets the program 'DynFlags'.  Note: this invalidates the internal
-- cached module graph, causing more work to be done the next time
-- 'load' is called.
605
setProgramDynFlags :: GhcMonad m => DynFlags -> m [InstalledUnitId]
606 607 608 609 610
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.
611 612
setLogAction :: GhcMonad m => LogAction -> m ()
setLogAction action = do
613 614
  dflags' <- getProgramDynFlags
  void $ setProgramDynFlags_ False $
615
    dflags' { log_action = action }
616 617 618

setProgramDynFlags_ :: GhcMonad m => Bool -> DynFlags -> m [InstalledUnitId]
setProgramDynFlags_ invalidate_needed dflags = do
619
  dflags' <- checkNewDynFlags dflags
620 621 622 623 624
  dflags_prev <- getProgramDynFlags
  (dflags'', preload) <-
    if (packageFlagsChanged dflags_prev dflags')
       then liftIO $ initPackages dflags'
       else return (dflags', [])
625
  modifySession $ \h -> h{ hsc_dflags = dflags'' }
626
  when invalidate_needed $ invalidateModSummaryCache
627
  return preload
628

629

630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645
-- 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
646
-- recompile a module, we'll have re-summarised the module and have a
647 648 649 650
-- correct ModSummary.
--
invalidateModSummaryCache :: GhcMonad m => m ()
invalidateModSummaryCache =
651
  modifySession $ \h -> h { hsc_mod_graph = mapMG inval (hsc_mod_graph h) }
652 653 654
 where
  inval ms = ms { ms_hs_date = addUTCTime (-1) (ms_hs_date ms) }

655 656 657 658 659 660 661 662 663 664
-- | 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
665
  dflags' <- checkNewDynFlags dflags
666 667
  dflags'' <- checkNewInteractiveDynFlags dflags'
  modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags'' }}
668 669 670 671 672

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

673

674
parseDynamicFlags :: MonadIO m =>
675
                     DynFlags -> [Located String]
676
                  -> m (DynFlags, [Located String], [Warn])
677 678
parseDynamicFlags = parseDynamicFlagsCmdLine

679 680 681 682
-- | 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
683 684 685
checkNewDynFlags dflags = do
  -- See Note [DynFlags consistency]
  let (dflags', warnings) = makeDynFlagsConsistent dflags
686
  liftIO $ handleFlagWarnings dflags (map (Warn NoReason) warnings)
Ben Gamari's avatar
Ben Gamari committed
687
  return dflags'
688

689 690
checkNewInteractiveDynFlags :: MonadIO m => DynFlags -> m DynFlags
checkNewInteractiveDynFlags dflags0 = do
691 692
  -- We currently don't support use of StaticPointers in expressions entered on
  -- the REPL. See #12356.
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
693 694 695 696 697 698
  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
699 700


701
-- %************************************************************************
dterei's avatar
dterei committed
702
-- %*                                                                      *
703
--             Setting, getting, and modifying the targets
dterei's avatar
dterei committed
704
-- %*                                                                      *
705
-- %************************************************************************
706 707 708 709 710 711

-- 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
712
-- the program\/library.  Unloading the current program is achieved by
713 714 715
-- 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 })
716

717 718 719
-- | Returns the current set of targets
getTargets :: GhcMonad m => m [Target]
getTargets = withSession (return . hsc_targets)
720

721 722 723 724
-- | Add another target.
addTarget :: GhcMonad m => Target -> m ()
addTarget target
  = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
725

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

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

dterei's avatar
dterei committed
772 773
         hs_file  = file <.> "hs"
         lhs_file = file <.> "lhs"
774

Simon Marlow's avatar
Simon Marlow committed
775 776
         target tid = Target tid obj_allowed Nothing

777

778 779
-- | Inform GHC that the working directory has changed.  GHC will flush
-- its cache of module locations, since it may no longer be valid.
780
--
781 782 783 784 785 786
-- 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)
787

788 789

-- %************************************************************************
dterei's avatar
dterei committed
790
-- %*                                                                      *
791
--             Running phases one at a time
dterei's avatar
dterei committed
792
-- %*                                                                      *
793
-- %************************************************************************
794 795 796 797 798 799 800 801 802 803

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
804 805 806 807 808
        -- 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.
809 810 811 812 813 814 815

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

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

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
842
  moduleInfo m        = tm_checked_module_info m
843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863
  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
864

865
type ParsedSource      = Located HsModule
866
type RenamedSource     = (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],
867
                          Maybe LHsDocString)
868
type TypecheckedSource = LHsBinds GhcTc
869

870 871 872 873 874 875 876 877 878 879 880 881
-- 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

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

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

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

931
 return $
932 933 934 935 936 937 938 939
     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,
940
           minf_exports   = md_exports details,
941
           minf_rdr_env   = Just (tcg_rdr_env tc_gbl_env),
942
           minf_instances = fixSafeInstances safe $ md_insts details,
943
           minf_iface     = Nothing,
944 945
           minf_safe      = safe,
           minf_modBreaks = emptyModBreaks
946 947 948 949 950
         }}

-- | Desugar a typechecked module.
desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
desugarModule tcm = do
951
 let ms = modSummary tcm
952 953 954 955 956
 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 $
957 958 959 960 961 962 963
     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
964 965 966 967 968 969 970
-- 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).
--
971 972 973 974
loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
loadModule tcm = do
   let ms = modSummary tcm
   let mod = ms_mod_name ms
975
   let loc = ms_location ms
976 977
   let (tcg, _details) = tm_internals tcm

978
   mb_linkable <- case ms_obj_date ms of
979
                     Just t | t > ms_hs_date ms  -> do
980
                         l <- liftIO $ findObjectLinkable (ms_mod ms)
981 982 983
                                                  (ml_obj_file loc) t
                         return (Just l)
                     _otherwise -> return Nothing
984

985 986 987 988
   let source_modified | isNothing mb_lin