GHC.hs 51.8 KB
Newer Older
1
-- -----------------------------------------------------------------------------
2
--
3
-- (c) The University of Glasgow, 2005
4 5 6
--
-- The GHC API
--
7
-- -----------------------------------------------------------------------------
8 9

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

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

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

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

        -- ** Compiling to Core
        CoreModule(..),
56
        compileToCoreModule, compileToCoreSimplified,
57
        compileCoreToObj,
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 84 85
        -- * Querying the environment
        packageDbModules,

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

dterei's avatar
dterei committed
89 90
        -- * Interactive evaluation
        getBindings, getInsts, getPrintUnqual,
dterei's avatar
dterei committed
91
        findModule, lookupModule,
92
#ifdef GHCI
dterei's avatar
dterei committed
93
        isModuleTrusted,
dterei's avatar
dterei committed
94
        moduleTrustReqs,
dterei's avatar
dterei committed
95 96 97
        setContext, getContext, 
        getNamesInScope,
        getRdrNamesInScope,
98
        getGRE,
dterei's avatar
dterei committed
99 100 101 102 103 104 105
        moduleIsInterpreted,
        getInfo,
        exprType,
        typeKind,
        parseName,
        RunResult(..),  
        runStmt, runStmtWithLocation, runDecls, runDeclsWithLocation,
vivian's avatar
vivian committed
106
        parseImportDecl, SingleStep(..),
107 108 109
        resume,
        Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
               resumeHistory, resumeHistoryIx),
110
        History(historyBreakInfo, historyEnclosingDecls), 
111
        GHC.getHistorySpan, getHistoryModule,
112 113
        getResumeContext,
        abandon, abandonAll,
114 115
        InteractiveEval.back,
        InteractiveEval.forward,
dterei's avatar
dterei committed
116
        showModule,
117
        isModuleInterpreted,
dterei's avatar
dterei committed
118
        InteractiveEval.compileExpr, HValue, dynCompileExpr,
pepe's avatar
pepe committed
119
        GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
120
        modInfoModBreaks,
121 122
        ModBreaks(..), BreakIndex,
        BreakInfo(breakInfo_number, breakInfo_module),
123
        BreakArray, setBreakOn, setBreakOff, getBreak,
124
#endif
125
        lookupName,
126

dterei's avatar
dterei committed
127 128 129 130 131
#ifdef GHCI
        -- ** EXPERIMENTAL
        setGHCiMonad,
#endif

dterei's avatar
dterei committed
132
        -- * Abstract syntax elements
133

Simon Marlow's avatar
Simon Marlow committed
134 135 136
        -- ** Packages
        PackageId,

dterei's avatar
dterei committed
137 138
        -- ** Modules
        Module, mkModule, pprModule, moduleName, modulePackageId,
Simon Marlow's avatar
Simon Marlow committed
139
        ModuleName, mkModuleName, moduleNameString,
140

dterei's avatar
dterei committed
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 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
        TyCon, 
        tyConTyVars, tyConDataCons, tyConArity,
        isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
        isFamilyTyCon, tyConClass_maybe,
        synTyConDefn, synTyConType, synTyConResKind,

        -- ** Type variables
        TyVar,
        alphaTyVars,

        -- ** Data constructors
        DataCon,
        dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
        dataConIsInfix, isVanillaDataCon, dataConUserType,
        dataConStrictMarks,  
        StrictnessMark(..), isMarkedStrict,

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

        -- ** Instances
181
        ClsInst, 
dterei's avatar
dterei committed
182
        instanceDFunId, 
183 184
        pprInstance, pprInstanceHdr,
        pprFamInst, pprFamInstHdr,
185

dterei's avatar
dterei committed
186 187 188 189 190 191
        -- ** Types and Kinds
        Type, splitForAllTys, funResultTy, 
        pprParendType, pprTypeApp, 
        Kind,
        PredType,
        ThetaType, pprForAll, pprThetaArrowTy,
192

dterei's avatar
dterei committed
193 194
        -- ** Entities
        TyThing(..), 
195

dterei's avatar
dterei committed
196 197
        -- ** Syntax
        module HsSyn, -- ToDo: remove extraneous bits
198

dterei's avatar
dterei committed
199 200 201 202 203
        -- ** Fixities
        FixityDirection(..), 
        defaultFixity, maxPrecedence, 
        negateFixity,
        compareFixity,
204

dterei's avatar
dterei committed
205 206
        -- ** Source locations
        SrcLoc(..), RealSrcLoc, 
Ian Lynagh's avatar
Ian Lynagh committed
207
        mkSrcLoc, noSrcLoc,
dterei's avatar
dterei committed
208
        srcLocFile, srcLocLine, srcLocCol,
209
        SrcSpan(..), RealSrcSpan,
Simon Marlow's avatar
Simon Marlow committed
210
        mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
Simon Marlow's avatar
Simon Marlow committed
211
        srcSpanStart, srcSpanEnd,
dterei's avatar
dterei committed
212
        srcSpanFile, 
Simon Marlow's avatar
Simon Marlow committed
213 214
        srcSpanStartLine, srcSpanEndLine, 
        srcSpanStartCol, srcSpanEndCol,
215

216
        -- ** Located
dterei's avatar
dterei committed
217
        GenLocated(..), Located,
218

dterei's avatar
dterei committed
219 220
        -- *** Constructing Located
        noLoc, mkGeneralLocated,
221

dterei's avatar
dterei committed
222 223
        -- *** Deconstructing Located
        getLoc, unLoc,
224

dterei's avatar
dterei committed
225 226
        -- *** Combining and comparing Located values
        eqLocated, cmpLocated, combineLocs, addCLoc,
227 228 229
        leftmost_smallest, leftmost_largest, rightmost,
        spans, isSubspanOf,

dterei's avatar
dterei committed
230 231
        -- * Exceptions
        GhcException(..), showGhcException,
232

Jedai's avatar
Jedai committed
233 234 235 236 237
        -- * Token stream manipulations
        Token,
        getTokenStream, getRichTokenStream,
        showRichTokenStream, addSourceToTokens,

238 239 240
        -- * Pure interface to the parser
        parser,

dterei's avatar
dterei committed
241 242 243
        -- * Miscellaneous
        --sessionHscEnv,
        cyclicModuleErr,
244 245
  ) where

246 247 248
{-
 ToDo:

249
  * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
250 251 252 253 254 255
  * what StaticFlags should we expose, if any?
-}

#include "HsVersions.h"

#ifdef GHCI
256
import Linker           ( HValue )
257
import ByteCodeInstr
258
import BreakArray
259
import InteractiveEval
260 261
#endif

262
import HscMain
263
import GhcMake
dterei's avatar
dterei committed
264
import DriverPipeline   ( compile' )
265
import GhcMonad
266
import TcRnMonad        ( finalSafeMode )
267
import TcRnTypes
268 269 270
import Packages
import NameSet
import RdrName
Ian Lynagh's avatar
Ian Lynagh committed
271
import qualified HsSyn -- hack as we want to reexport the whole module
272
import HsSyn
batterseapower's avatar
batterseapower committed
273
import Type     hiding( typeKind )
dterei's avatar
dterei committed
274 275
import Kind             ( synTyConResKind )
import TcType           hiding( typeKind )
276
import Id
dterei's avatar
dterei committed
277
import TysPrim          ( alphaTyVars )
278 279 280 281
import TyCon
import Class
import DataCon
import Name             hiding ( varName )
282
import Avail
283
import InstEnv
284
import FamInstEnv
285
import SrcLoc
286
import CoreSyn
287
import TidyPgm
288
import DriverPhases     ( Phase(..), isHaskellSrcFilename )
289 290 291
import Finder
import HscTypes
import DynFlags
292
import StaticFlagParser
293
import qualified StaticFlags
294
import SysTools
295
import Annotations
296
import Module
297
import UniqFM
298
import Panic
dterei's avatar
dterei committed
299
import Bag              ( unitBag )
300
import ErrUtils
301
import MonadUtils
302
import Util
303
import StringBuffer
304
import Outputable
305
import BasicTypes
dterei's avatar
dterei committed
306
import Maybes           ( expectJust )
307
import FastString
308
import qualified Parser
Jedai's avatar
Jedai committed
309
import Lexer
310

311
import System.Directory ( doesFileExist, getCurrentDirectory )
312
import Data.Maybe
dterei's avatar
dterei committed
313
import Data.List        ( find )
314
import Data.Time
315 316
import Data.Typeable    ( Typeable )
import Data.Word        ( Word8 )
317
import Control.Monad
dterei's avatar
dterei committed
318
import System.Exit      ( exitWith, ExitCode(..) )
319
import Exception
320
import Data.IORef
Ian Lynagh's avatar
Ian Lynagh committed
321
import System.FilePath
322
import System.IO
Ian Lynagh's avatar
Ian Lynagh committed
323
import Prelude hiding (init)
324

325

326
-- %************************************************************************
dterei's avatar
dterei committed
327
-- %*                                                                      *
328
--             Initialisation: exception handlers
dterei's avatar
dterei committed
329
-- %*                                                                      *
330 331
-- %************************************************************************

332 333 334 335 336

-- | 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.
337
defaultErrorHandler :: (ExceptionMonad m, MonadIO m)
Ian Lynagh's avatar
Ian Lynagh committed
338 339
                    => FatalMessager -> FlushOut -> m a -> m a
defaultErrorHandler fm (FlushOut flushOut) inner =
340
  -- top-level exception handler: any unrecognised exception is a compiler bug.
341
  ghandle (\exception -> liftIO $ do
342
           flushOut
343
           case fromException exception of
344 345
                -- an IO exception probably isn't our fault, so don't panic
                Just (ioe :: IOException) ->
Ian Lynagh's avatar
Ian Lynagh committed
346
                  fatalErrorMsg'' fm (show ioe)
347
                _ -> case fromException exception of
dterei's avatar
dterei committed
348
                     Just UserInterrupt -> exitWith (ExitFailure 1)
349
                     Just StackOverflow ->
Ian Lynagh's avatar
Ian Lynagh committed
350
                         fatalErrorMsg'' fm "stack overflow: use +RTS -K<size> to increase it"
351
                     _ -> case fromException exception of
352 353
                          Just (ex :: ExitCode) -> throw ex
                          _ ->
Ian Lynagh's avatar
Ian Lynagh committed
354 355
                              fatalErrorMsg'' fm
                                  (show (Panic (show exception)))
356
           exitWith (ExitFailure 1)
357 358
         ) $

359
  -- error messages propagated as exceptions
360
  handleGhcException
361
            (\ge -> liftIO $ do
362
                flushOut
dterei's avatar
dterei committed
363 364 365
                case ge of
                     PhaseFailed _ code -> exitWith code
                     Signal _ -> exitWith (ExitFailure 1)
Ian Lynagh's avatar
Ian Lynagh committed
366
                     _ -> do fatalErrorMsg'' fm (show ge)
dterei's avatar
dterei committed
367 368
                             exitWith (ExitFailure 1)
            ) $
369 370
  inner

371 372 373 374 375 376 377
-- | Install a default cleanup handler to remove temporary files deposited by
-- a GHC run.  This is seperate from 'defaultErrorHandler', because you might
-- want to override the error handling, but still get the ordinary cleanup
-- behaviour.
defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
                         DynFlags -> m a -> m a
defaultCleanupHandler dflags inner =
378
    -- make sure we clean up after ourselves
379
    inner `gfinally`
380 381
          (liftIO $ do
              cleanTempFiles dflags
382
              cleanTempDirs dflags
383
          )
384
          --  exceptions will be blocked while we clean the temporary files,
385 386
          -- so there shouldn't be any difficulty if we receive further
          -- signals.
387

388

389
-- %************************************************************************
dterei's avatar
dterei committed
390
-- %*                                                                      *
391
--             The Ghc Monad
dterei's avatar
dterei committed
392
-- %*                                                                      *
393
-- %************************************************************************
394 395 396 397 398 399 400 401 402 403 404 405 406 407

-- | 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
408
  ref <- newIORef (panic "empty session")
409
  let session = Session ref
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425
  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.

runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
           Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
        -> GhcT m a        -- ^ The action to perform.
        -> m a
runGhcT mb_top_dir ghct = do
426
  ref <- liftIO $ newIORef (panic "empty session")
427
  let session = Session ref
428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445
  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
-- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.

initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
initGhcMonad mb_top_dir = do
446
  -- catch ^C
447 448 449 450
  liftIO $ installSignalHandlers

  liftIO $ StaticFlags.initStaticOpts

451
  mySettings <- liftIO $ initSysTools mb_top_dir
452
  dflags <- liftIO $ initDynFlags (defaultDynFlags mySettings)
453
  env <- liftIO $ newHscEnv dflags
454
  setSession env
455

456 457

-- %************************************************************************
dterei's avatar
dterei committed
458
-- %*                                                                      *
459
--             Flags & settings
dterei's avatar
dterei committed
460
-- %*                                                                      *
461
-- %************************************************************************
462

463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489
-- $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).
490 491 492 493 494 495
--
-- 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.
--
496 497 498
setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
setSessionDynFlags dflags = do
  (dflags', preload) <- liftIO $ initPackages dflags
499 500 501 502 503 504 505 506 507
  modifySession $ \h -> h{ hsc_dflags = dflags'
                         , hsc_IC = (hsc_IC h){ ic_dflags = dflags' } }
  return preload

-- | Sets the program 'DynFlags'.
setProgramDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
setProgramDynFlags dflags = do
  (dflags', preload) <- liftIO $ initPackages dflags
  modifySession $ \h -> h{ hsc_dflags = dflags' }
508
  return preload
509

510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525
-- | 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
  modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags }}

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

526

527 528 529 530 531
parseDynamicFlags :: Monad m =>
                     DynFlags -> [Located String]
                  -> m (DynFlags, [Located String], [Located String])
parseDynamicFlags = parseDynamicFlagsCmdLine

532 533

-- %************************************************************************
dterei's avatar
dterei committed
534
-- %*                                                                      *
535
--             Setting, getting, and modifying the targets
dterei's avatar
dterei committed
536
-- %*                                                                      *
537
-- %************************************************************************
538 539 540 541 542 543

-- 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
544
-- the program\/library.  Unloading the current program is achieved by
545 546 547
-- 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 })
548

549 550 551
-- | Returns the current set of targets
getTargets :: GhcMonad m => m [Target]
getTargets = withSession (return . hsc_targets)
552

553 554 555 556
-- | Add another target.
addTarget :: GhcMonad m => Target -> m ()
addTarget target
  = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
557

558
-- | Remove a target
559 560 561
removeTarget :: GhcMonad m => TargetId -> m ()
removeTarget target_id
  = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
562
  where
Simon Marlow's avatar
Simon Marlow committed
563
   filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
564

565 566 567 568 569 570 571 572
-- | 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
573
--
574
--   - otherwise interpret the string as a module name
575
--
576
guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
Simon Marlow's avatar
Simon Marlow committed
577 578 579
guessTarget str (Just phase)
   = return (Target (TargetFile str (Just phase)) True Nothing)
guessTarget str Nothing
580
   | isHaskellSrcFilename file
Simon Marlow's avatar
Simon Marlow committed
581
   = return (target (TargetFile file Nothing))
582
   | otherwise
583
   = do exists <- liftIO $ doesFileExist hs_file
dterei's avatar
dterei committed
584 585 586 587 588 589 590
        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
591 592 593
        if looksLikeModuleName file
           then return (target (TargetModule (mkModuleName file)))
           else do
Ian Lynagh's avatar
Ian Lynagh committed
594
        dflags <- getDynFlags
595
        throwGhcException
Ian Lynagh's avatar
Ian Lynagh committed
596
                 (ProgramError (showSDoc dflags $
Simon Marlow's avatar
Simon Marlow committed
597 598
                 text "target" <+> quotes (text file) <+> 
                 text "is not a module name or a source file"))
599
     where 
Simon Marlow's avatar
Simon Marlow committed
600 601 602 603
         (file,obj_allowed)
                | '*':rest <- str = (rest, False)
                | otherwise       = (str,  True)

dterei's avatar
dterei committed
604 605
         hs_file  = file <.> "hs"
         lhs_file = file <.> "lhs"
606

Simon Marlow's avatar
Simon Marlow committed
607 608
         target tid = Target tid obj_allowed Nothing

609

610 611 612 613 614 615 616 617 618
-- | 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)
619

620 621

-- %************************************************************************
dterei's avatar
dterei committed
622
-- %*                                                                      *
623
--             Running phases one at a time
dterei's avatar
dterei committed
624
-- %*                                                                      *
625
-- %************************************************************************
626 627 628 629 630 631 632 633 634 635

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
636 637 638 639 640
        -- 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.
641 642 643 644 645 646 647

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

-- | The result of successful parsing.
data ParsedModule =
  ParsedModule { pm_mod_summary   :: ModSummary
648 649
               , pm_parsed_source :: ParsedSource
               , pm_extra_src_files :: [FilePath] }
650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671

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
672
  moduleInfo m        = tm_checked_module_info m
673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693
  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
694

695
type ParsedSource      = Located (HsModule RdrName)
696
type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
697
                          Maybe LHsDocString)
698 699
type TypecheckedSource = LHsBinds Id

700 701 702 703 704 705 706 707 708 709 710 711
-- 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

712 713 714
-- | Return the 'ModSummary' of a module with the given name.
--
-- The module must be part of the module graph (see 'hsc_mod_graph' and
715
-- 'ModuleGraph').  If this is not the case, this function will throw a
716 717
-- 'GhcApiError'.
--
718 719
-- This function ignores boot modules and requires that there is only one
-- non-boot module with the given name.
720 721 722
getModSummary :: GhcMonad m => ModuleName -> m ModSummary
getModSummary mod = do
   mg <- liftM hsc_mod_graph getSession
723
   case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
724 725
     [] -> do dflags <- getDynFlags
              throw $ mkApiErr dflags (text "Module not part of module graph")
726
     [ms] -> return ms
727 728
     multiple -> do dflags <- getDynFlags
                    throw $ mkApiErr dflags (text "getModSummary is ambiguous: " <+> ppr multiple)
729 730 731 732

-- | Parse a module.
--
-- Throws a 'SourceError' on parse error.
733 734
parseModule :: GhcMonad m => ModSummary -> m ParsedModule
parseModule ms = do
735 736
   hsc_env <- getSession
   let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
737 738
   hpm <- liftIO $ hscParse hsc_env_tmp ms
   return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm))
739 740 741 742 743 744

-- | 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
745
 let ms = modSummary pmod
746 747 748
 hsc_env <- getSession
 let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 (tc_gbl_env, rn_info)
749 750 751
       <- liftIO $ hscTypecheckRename hsc_env_tmp ms $
                      HsParsedModule { hpm_module = parsedSource pmod,
                                       hpm_src_files = pm_extra_src_files pmod }
752
 details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
753
 safe    <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env
754
 return $
755 756 757 758 759 760 761 762 763 764
     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,
           minf_exports   = availsToNameSet $ md_exports details,
           minf_rdr_env   = Just (tcg_rdr_env tc_gbl_env),
765
           minf_instances = md_insts details,
766 767
           minf_iface     = Nothing,
           minf_safe      = safe
mnislaih's avatar
mnislaih committed
768
#ifdef GHCI
769
          ,minf_modBreaks = emptyModBreaks
mnislaih's avatar
mnislaih committed
770
#endif
771 772 773 774 775
         }}

-- | Desugar a typechecked module.
desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
desugarModule tcm = do
Thomas Schilling's avatar
Thomas Schilling committed
776
 let ms = modSummary tcm
777 778 779 780 781
 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 $
782 783 784 785 786 787 788
     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
789 790 791 792 793 794 795
-- 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).
--
796 797 798 799
loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
loadModule tcm = do
   let ms = modSummary tcm
   let mod = ms_mod_name ms
800
   let loc = ms_location ms
801 802
   let (tcg, _details) = tm_internals tcm

803
   mb_linkable <- case ms_obj_date ms of
804 805 806 807 808 809
                     Just t | t > ms_hs_date ms  -> do
                         l <- liftIO $ findObjectLinkable (ms_mod ms) 
                                                  (ml_obj_file loc) t
                         return (Just l)
                     _otherwise -> return Nothing
                                                
810 811 812 813
   let source_modified | isNothing mb_linkable = SourceModified
                       | otherwise             = SourceUnmodified
                       -- we can't determine stability here

814 815 816 817 818 819
   -- compile doesn't change the session
   hsc_env <- getSession
   mod_info <- liftIO $ compile' (hscNothingBackendOnly     tcg,
                                  hscInteractiveBackendOnly tcg,
                                  hscBatchBackendOnly       tcg)
                                  hsc_env ms 1 1 Nothing mb_linkable
820
                                  source_modified
821 822

   modifySession $ \e -> e{ hsc_HPT = addToUFM (hsc_HPT e) mod mod_info }
823
   return tcm
824

825 826

-- %************************************************************************
dterei's avatar
dterei committed
827
-- %*                                                                      *
828
--             Dealing with Core
dterei's avatar
dterei committed
829
-- %*                                                                      *
830
-- %************************************************************************
831 832 833 834 835 836 837 838 839 840

-- | 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
841 842 843
      cm_binds    :: CoreProgram,
      -- | Safe Haskell mode
      cm_safe     :: SafeHaskellMode
844 845 846
    }

instance Outputable CoreModule where
847 848 849 850
   ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb,
                    cm_safe = sf})
    = text "%module" <+> ppr mn <+> parens (ppr sf) <+> ppr te
      $$ vcat (map ppr cb)
851

852
-- | This is the way to get access to the Core bindings corresponding
853 854
-- to a module. 'compileToCore' parses, typechecks, and
-- desugars the module, then returns the resulting Core module (consisting of
855 856
-- the module name, type declarations, and function declarations) if
-- successful.
857
compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
858 859 860 861
compileToCoreModule = compileCore False

-- | Like compileToCoreModule, but invokes the simplifier, so
-- as to return simplified and tidied Core.
862
compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
863 864 865 866 867 868 869
compileToCoreSimplified = compileCore True
-- | Takes a CoreModule and compiles the bindings therein
-- to object code. The first argument is a bool flag indicating
-- whether to run the simplifier.
-- The resulting .o, .hi, and executable files, if any, are stored in the
-- current directory, and named according to the module name.
-- This has only so far been tested with a single self-contained module.
870 871 872
compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
  dflags      <- getSessionDynFlags
873
  currentTime <- liftIO $ getCurrentTime
874 875
  cwd         <- liftIO $ getCurrentDirectory
  modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
876 877
                   ((moduleNameSlashes . moduleName) mName)

878
  let modSum = ModSummary { ms_mod = mName,
879 880 881 882 883 884 885 886 887 888
         ms_hsc_src = ExtCoreFile,
         ms_location = modLocation,
         -- By setting the object file timestamp to Nothing,
         -- we always force recompilation, which is what we
         -- want. (Thus it doesn't matter what the timestamp
         -- for the (nonexistent) source file is.)
         ms_hs_date = currentTime,
         ms_obj_date = Nothing,
         -- Only handling the single-module case for now, so no imports.
         ms_srcimps = [],
889
         ms_textual_imps = [],
890 891 892 893 894 895
         -- No source file
         ms_hspp_file = "",
         ms_hspp_opts = dflags,
         ms_hspp_buf = Nothing
      }

896
  hsc_env <- getSession
897
  liftIO $ hscCompileCore hsc_env simplify (cm_safe cm) modSum (cm_binds cm)