compiler/main/GHC.hs

   1 -- -----------------------------------------------------------------------------
   2 --
   3 -- (c) The University of Glasgow, 2005
   4 --
   5 -- The GHC API
   6 --
   7 -- -----------------------------------------------------------------------------
   8
   9 module GHC (
  10         -- * Initialisation
  11         defaultErrorHandler,
  12         defaultCleanupHandler,
  13
  14         -- * GHC Monad
  15         Ghc, GhcT, GhcMonad(..),
  16         runGhc, runGhcT, initGhcMonad,
  17         gcatch, gbracket, gfinally,
  18         printException,
  19         printExceptionAndWarnings,
  20         handleSourceError,
  21         needsTemplateHaskell,
  22
  23         -- * Flags and settings
  24         DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
  25         GhcMode(..), GhcLink(..), defaultObjectTarget,
  26         parseDynamicFlags,
  27         getSessionDynFlags,
  28         setSessionDynFlags,
  29         parseStaticFlags,
  30
  31         -- * Targets
  32         Target(..), TargetId(..), Phase,
  33         setTargets,
  34         getTargets,
  35         addTarget,
  36         removeTarget,
  37         guessTarget,
  38
  39         -- * Loading\/compiling the program
  40         depanal,
  41         load, LoadHowMuch(..),
  42         SuccessFlag(..), succeeded, failed,
  43         defaultWarnErrLogger, WarnErrLogger,
  44         workingDirectoryChanged,
  45         parseModule, typecheckModule, desugarModule, loadModule,
  46         ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),
  47         TypecheckedSource, ParsedSource, RenamedSource,   -- ditto
  48         TypecheckedMod, ParsedMod,
  49         moduleInfo, renamedSource, typecheckedSource,
  50         parsedSource, coreModule,
  51         compileToCoreModule, compileToCoreSimplified,
  52         compileCoreToObj,
  53         getModSummary,
  54
  55         -- * Inspecting the module structure of the program
  56         ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
  57         getModuleGraph,
  58         isLoaded,
  59         topSortModuleGraph,
  60
  61         -- * Inspecting modules
  62         ModuleInfo,
  63         getModuleInfo,
  64         modInfoTyThings,
  65         modInfoTopLevelScope,
  66         modInfoExports,
  67         modInfoInstances,
  68         modInfoIsExportedName,
  69         modInfoLookupName,
  70         lookupGlobalName,
  71         findGlobalAnns,
  72         mkPrintUnqualifiedForModule,
  73
  74         -- * Querying the environment
  75         packageDbModules,
  76
  77         -- * Printing
  78         PrintUnqualified, alwaysQualify,
  79
  80         -- * Interactive evaluation
  81         getBindings, getPrintUnqual,
  82         findModule,
  83         lookupModule,
  84 #ifdef GHCI
  85         setContext, getContext,
  86         getNamesInScope,
  87         getRdrNamesInScope,
  88         getGRE,
  89         moduleIsInterpreted,
  90         getInfo,
  91         exprType,
  92         typeKind,
  93         parseName,
  94         RunResult(..),
  95         runStmt, runStmtWithLocation,
  96         parseImportDecl, SingleStep(..),
  97         resume,
  98         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
  99                resumeHistory, resumeHistoryIx),
 100         History(historyBreakInfo, historyEnclosingDecls),
 101         GHC.getHistorySpan, getHistoryModule,
 102         getResumeContext,
 103         abandon, abandonAll,
 104         InteractiveEval.back,
 105         InteractiveEval.forward,
 106         showModule,
 107         isModuleInterpreted,
 108         InteractiveEval.compileExpr, HValue, dynCompileExpr,
 109         GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
 110         modInfoModBreaks,
 111         ModBreaks(..), BreakIndex,
 112         BreakInfo(breakInfo_number, breakInfo_module),
 113         BreakArray, setBreakOn, setBreakOff, getBreak,
 114 #endif
 115         lookupName,
 116
 117         -- * Abstract syntax elements
 118
 119         -- ** Packages
 120         PackageId,
 121
 122         -- ** Modules
 123         Module, mkModule, pprModule, moduleName, modulePackageId,
 124         ModuleName, mkModuleName, moduleNameString,
 125
 126         -- ** Names
 127         Name,
 128         isExternalName, nameModule, pprParenSymName, nameSrcSpan,
 129         NamedThing(..),
 130         RdrName(Qual,Unqual),
 131
 132         -- ** Identifiers
 133         Id, idType,
 134         isImplicitId, isDeadBinder,
 135         isExportedId, isLocalId, isGlobalId,
 136         isRecordSelector,
 137         isPrimOpId, isFCallId, isClassOpId_maybe,
 138         isDataConWorkId, idDataCon,
 139         isBottomingId, isDictonaryId,
 140         recordSelectorFieldLabel,
 141
 142         -- ** Type constructors
 143         TyCon,
 144         tyConTyVars, tyConDataCons, tyConArity,
 145         isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
 146         isFamilyTyCon,
 147         synTyConDefn, synTyConType, synTyConResKind,
 148
 149         -- ** Type variables
 150         TyVar,
 151         alphaTyVars,
 152
 153         -- ** Data constructors
 154         DataCon,
 155         dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
 156         dataConIsInfix, isVanillaDataCon, dataConUserType,
 157         dataConStrictMarks,
 158         StrictnessMark(..), isMarkedStrict,
 159
 160         -- ** Classes
 161         Class,
 162         classMethods, classSCTheta, classTvsFds,
 163         pprFundeps,
 164
 165         -- ** Instances
 166         Instance,
 167         instanceDFunId, pprInstance, pprInstanceHdr,
 168
 169         -- ** Types and Kinds
 170         Type, splitForAllTys, funResultTy,
 171         pprParendType, pprTypeApp,
 172         Kind,
 173         PredType,
 174         ThetaType, pprForAll, pprThetaArrow,
 175
 176         -- ** Entities
 177         TyThing(..),
 178
 179         -- ** Syntax
 180         module HsSyn, -- ToDo: remove extraneous bits
 181
 182         -- ** Fixities
 183         FixityDirection(..),
 184         defaultFixity, maxPrecedence,
 185         negateFixity,
 186         compareFixity,
 187
 188         -- ** Source locations
 189         SrcLoc, pprDefnLoc,
 190         mkSrcLoc, isGoodSrcLoc, noSrcLoc,
 191         srcLocFile, srcLocLine, srcLocCol,
 192         SrcSpan,
 193         mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
 194         srcSpanStart, srcSpanEnd,
 195         srcSpanFile,
 196         srcSpanStartLine, srcSpanEndLine,
 197         srcSpanStartCol, srcSpanEndCol,
 198
 199         -- ** Located
 200         Located(..),
 201
 202         -- *** Constructing Located
 203         noLoc, mkGeneralLocated,
 204
 205         -- *** Deconstructing Located
 206         getLoc, unLoc,
 207
 208         -- *** Combining and comparing Located values
 209         eqLocated, cmpLocated, combineLocs, addCLoc,
 210         leftmost_smallest, leftmost_largest, rightmost,
 211         spans, isSubspanOf,
 212
 213         -- * Exceptions
 214         GhcException(..), showGhcException,
 215
 216         -- * Token stream manipulations
 217         Token,
 218         getTokenStream, getRichTokenStream,
 219         showRichTokenStream, addSourceToTokens,
 220
 221         -- * Pure interface to the parser
 222         parser,
 223
 224         -- * Miscellaneous
 225         --sessionHscEnv,
 226         cyclicModuleErr,
 227   ) where
 228
 229 {-
 230  ToDo:
 231
 232   * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
 233   * what StaticFlags should we expose, if any?
 234 -}
 235
 236 #include "HsVersions.h"
 237
 238 #ifdef GHCI
 239 import Linker           ( HValue )
 240 import ByteCodeInstr
 241 import BreakArray
 242 import InteractiveEval
 243 #endif
 244
 245 import HscMain
 246 import GhcMake
 247 import DriverPipeline   ( compile' )
 248 import GhcMonad
 249 import TcRnTypes
 250 import Packages
 251 import NameSet
 252 import RdrName
 253 import qualified HsSyn -- hack as we want to reexport the whole module
 254 import HsSyn hiding ((<.>))
 255 import Type
 256 import Coercion         ( synTyConResKind )
 257 import TcType           hiding( typeKind )
 258 import Id
 259 import Var
 260 import TysPrim          ( alphaTyVars )
 261 import TyCon
 262 import Class
 263 -- import FunDeps
 264 import DataCon
 265 import Name             hiding ( varName )
 266 -- import OccName               ( parenSymOcc )
 267 import InstEnv
 268 import SrcLoc
 269 import CoreSyn          ( CoreBind )
 270 import TidyPgm
 271 import DriverPhases     ( Phase(..), isHaskellSrcFilename )
 272 import Finder
 273 import HscTypes
 274 import DynFlags
 275 import StaticFlagParser
 276 import qualified StaticFlags
 277 import SysTools     ( initSysTools, cleanTempFiles,
 278                       cleanTempDirs )
 279 import Annotations
 280 import Module
 281 import UniqFM
 282 import Panic
 283 import Bag              ( unitBag )
 284 import ErrUtils
 285 import MonadUtils
 286 import Util
 287 import StringBuffer
 288 import Outputable
 289 import BasicTypes
 290 import Maybes           ( expectJust )
 291 import FastString
 292 import qualified Parser
 293 import Lexer
 294
 295 import System.Directory ( doesFileExist, getCurrentDirectory )
 296 import Data.Maybe
 297 import Data.List        ( find )
 298 import Data.Typeable    ( Typeable )
 299 import Data.Word        ( Word8 )
 300 import Control.Monad
 301 import System.Exit      ( exitWith, ExitCode(..) )
 302 import System.Time      ( getClockTime )
 303 import Exception
 304 import Data.IORef
 305 import System.FilePath
 306 import System.IO
 307 import Prelude hiding (init)
 308
 309
 310 -- %************************************************************************
 311 -- %*                                                                      *
 312 --             Initialisation: exception handlers
 313 -- %*                                                                      *
 314 -- %************************************************************************
 315
 316
 317 -- | Install some default exception handlers and run the inner computation.
 318 -- Unless you want to handle exceptions yourself, you should wrap this around
 319 -- the top level of your program.  The default handlers output the error
 320 -- message(s) to stderr and exit cleanly.
 321 defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
 322 defaultErrorHandler dflags inner =
 323   -- top-level exception handler: any unrecognised exception is a compiler bug.
 324   ghandle (\exception -> liftIO $ do
 325            hFlush stdout
 326            case fromException exception of
 327                 -- an IO exception probably isn't our fault, so don't panic
 328                 Just (ioe :: IOException) ->
 329                   fatalErrorMsg dflags (text (show ioe))
 330                 _ -> case fromException exception of
 331                      Just UserInterrupt -> exitWith (ExitFailure 1)
 332                      Just StackOverflow ->
 333                          fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
 334                      _ -> case fromException exception of
 335                           Just (ex :: ExitCode) -> throw ex
 336                           _ ->
 337                               fatalErrorMsg dflags
 338                                   (text (show (Panic (show exception))))
 339            exitWith (ExitFailure 1)
 340          ) $
 341
 342   -- error messages propagated as exceptions
 343   handleGhcException
 344             (\ge -> liftIO $ do
 345                 hFlush stdout
 346                 case ge of
 347                      PhaseFailed _ code -> exitWith code
 348                      Signal _ -> exitWith (ExitFailure 1)
 349                      _ -> do fatalErrorMsg dflags (text (show ge))
 350                              exitWith (ExitFailure 1)
 351             ) $
 352   inner
 353
 354 -- | Install a default cleanup handler to remove temporary files deposited by
 355 -- a GHC run.  This is seperate from 'defaultErrorHandler', because you might
 356 -- want to override the error handling, but still get the ordinary cleanup
 357 -- behaviour.
 358 defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
 359                          DynFlags -> m a -> m a
 360 defaultCleanupHandler dflags inner =
 361     -- make sure we clean up after ourselves
 362     inner `gfinally`
 363           (liftIO $ do
 364               cleanTempFiles dflags
 365               cleanTempDirs dflags
 366           )
 367           --  exceptions will be blocked while we clean the temporary files,
 368           -- so there shouldn't be any difficulty if we receive further
 369           -- signals.
 370
 371
 372 -- %************************************************************************
 373 -- %*                                                                      *
 374 --             The Ghc Monad
 375 -- %*                                                                      *
 376 -- %************************************************************************
 377
 378 -- | Run function for the 'Ghc' monad.
 379 --
 380 -- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call
 381 -- to this function will create a new session which should not be shared among
 382 -- several threads.
 383 --
 384 -- Any errors not handled inside the 'Ghc' action are propagated as IO
 385 -- exceptions.
 386
 387 runGhc :: Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
 388        -> Ghc a           -- ^ The action to perform.
 389        -> IO a
 390 runGhc mb_top_dir ghc = do
 391   ref <- newIORef undefined
 392   let session = Session ref
 393   flip unGhc session $ do
 394     initGhcMonad mb_top_dir
 395     ghc
 396   -- XXX: unregister interrupt handlers here?
 397
 398 -- | Run function for 'GhcT' monad transformer.
 399 --
 400 -- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call
 401 -- to this function will create a new session which should not be shared among
 402 -- several threads.
 403
 404 runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
 405            Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
 406         -> GhcT m a        -- ^ The action to perform.
 407         -> m a
 408 runGhcT mb_top_dir ghct = do
 409   ref <- liftIO $ newIORef undefined
 410   let session = Session ref
 411   flip unGhcT session $ do
 412     initGhcMonad mb_top_dir
 413     ghct
 414
 415 -- | Initialise a GHC session.
 416 --
 417 -- If you implement a custom 'GhcMonad' you must call this function in the
 418 -- monad run function.  It will initialise the session variable and clear all
 419 -- warnings.
 420 --
 421 -- The first argument should point to the directory where GHC's library files
 422 -- reside.  More precisely, this should be the output of @ghc --print-libdir@
 423 -- of the version of GHC the module using this API is compiled with.  For
 424 -- portability, you should use the @ghc-paths@ package, available at
 425 -- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
 426
 427 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
 428 initGhcMonad mb_top_dir = do
 429   -- catch ^C
 430   liftIO $ installSignalHandlers
 431
 432   liftIO $ StaticFlags.initStaticOpts
 433
 434   dflags0 <- liftIO $ initDynFlags defaultDynFlags
 435   dflags <- liftIO $ initSysTools mb_top_dir dflags0
 436   env <- liftIO $ newHscEnv dflags
 437   setSession env
 438
 439
 440 -- %************************************************************************
 441 -- %*                                                                      *
 442 --             Flags & settings
 443 -- %*                                                                      *
 444 -- %************************************************************************
 445
 446 -- | Updates the DynFlags in a Session.  This also reads
 447 -- the package database (unless it has already been read),
 448 -- and prepares the compilers knowledge about packages.  It
 449 -- can be called again to load new packages: just add new
 450 -- package flags to (packageFlags dflags).
 451 --
 452 -- Returns a list of new packages that may need to be linked in using
 453 -- the dynamic linker (see 'linkPackages') as a result of new package
 454 -- flags.  If you are not doing linking or doing static linking, you
 455 -- can ignore the list of packages returned.
 456 --
 457 setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
 458 setSessionDynFlags dflags = do
 459   (dflags', preload) <- liftIO $ initPackages dflags
 460   modifySession (\h -> h{ hsc_dflags = dflags' })
 461   return preload
 462
 463
 464
 465 -- %************************************************************************
 466 -- %*                                                                      *
 467 --             Setting, getting, and modifying the targets
 468 -- %*                                                                      *
 469 -- %************************************************************************
 470
 471 -- ToDo: think about relative vs. absolute file paths. And what
 472 -- happens when the current directory changes.
 473
 474 -- | Sets the targets for this session.  Each target may be a module name
 475 -- or a filename.  The targets correspond to the set of root modules for
 476 -- the program\/library.  Unloading the current program is achieved by
 477 -- setting the current set of targets to be empty, followed by 'load'.
 478 setTargets :: GhcMonad m => [Target] -> m ()
 479 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
 480
 481 -- | Returns the current set of targets
 482 getTargets :: GhcMonad m => m [Target]
 483 getTargets = withSession (return . hsc_targets)
 484
 485 -- | Add another target.
 486 addTarget :: GhcMonad m => Target -> m ()
 487 addTarget target
 488   = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
 489
 490 -- | Remove a target
 491 removeTarget :: GhcMonad m => TargetId -> m ()
 492 removeTarget target_id
 493   = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
 494   where
 495    filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
 496
 497 -- | Attempts to guess what Target a string refers to.  This function
 498 -- implements the @--make@/GHCi command-line syntax for filenames:
 499 --
 500 --   - if the string looks like a Haskell source filename, then interpret it
 501 --     as such
 502 --
 503 --   - if adding a .hs or .lhs suffix yields the name of an existing file,
 504 --     then use that
 505 --
 506 --   - otherwise interpret the string as a module name
 507 --
 508 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
 509 guessTarget str (Just phase)
 510    = return (Target (TargetFile str (Just phase)) True Nothing)
 511 guessTarget str Nothing
 512    | isHaskellSrcFilename file
 513    = return (target (TargetFile file Nothing))
 514    | otherwise
 515    = do exists <- liftIO $ doesFileExist hs_file
 516         if exists
 517            then return (target (TargetFile hs_file Nothing))
 518            else do
 519         exists <- liftIO $ doesFileExist lhs_file
 520         if exists
 521            then return (target (TargetFile lhs_file Nothing))
 522            else do
 523         if looksLikeModuleName file
 524            then return (target (TargetModule (mkModuleName file)))
 525            else do
 526         throwGhcException
 527                  (ProgramError (showSDoc $
 528                  text "target" <+> quotes (text file) <+>
 529                  text "is not a module name or a source file"))
 530      where
 531          (file,obj_allowed)
 532                 | '*':rest <- str = (rest, False)
 533                 | otherwise       = (str,  True)
 534
 535          hs_file  = file <.> "hs"
 536          lhs_file = file <.> "lhs"
 537
 538          target tid = Target tid obj_allowed Nothing
 539
 540
 541 -- | Inform GHC that the working directory has changed.  GHC will flush
 542 -- its cache of module locations, since it may no longer be valid.
 543 --
 544 -- Note: Before changing the working directory make sure all threads running
 545 -- in the same session have stopped.  If you change the working directory,
 546 -- you should also unload the current program (set targets to empty,
 547 -- followed by load).
 548 workingDirectoryChanged :: GhcMonad m => m ()
 549 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
 550
 551
 552 -- %************************************************************************
 553 -- %*                                                                      *
 554 --             Running phases one at a time
 555 -- %*                                                                      *
 556 -- %************************************************************************
 557
 558 class ParsedMod m where
 559   modSummary   :: m -> ModSummary
 560   parsedSource :: m -> ParsedSource
 561
 562 class ParsedMod m => TypecheckedMod m where
 563   renamedSource     :: m -> Maybe RenamedSource
 564   typecheckedSource :: m -> TypecheckedSource
 565   moduleInfo        :: m -> ModuleInfo
 566   tm_internals      :: m -> (TcGblEnv, ModDetails)
 567         -- ToDo: improvements that could be made here:
 568         --  if the module succeeded renaming but not typechecking,
 569         --  we can still get back the GlobalRdrEnv and exports, so
 570         --  perhaps the ModuleInfo should be split up into separate
 571         --  fields.
 572
 573 class TypecheckedMod m => DesugaredMod m where
 574   coreModule :: m -> ModGuts
 575
 576 -- | The result of successful parsing.
 577 data ParsedModule =
 578   ParsedModule { pm_mod_summary   :: ModSummary
 579                , pm_parsed_source :: ParsedSource }
 580
 581 instance ParsedMod ParsedModule where
 582   modSummary m    = pm_mod_summary m
 583   parsedSource m = pm_parsed_source m
 584
 585 -- | The result of successful typechecking.  It also contains the parser
 586 --   result.
 587 data TypecheckedModule =
 588   TypecheckedModule { tm_parsed_module       :: ParsedModule
 589                     , tm_renamed_source      :: Maybe RenamedSource
 590                     , tm_typechecked_source  :: TypecheckedSource
 591                     , tm_checked_module_info :: ModuleInfo
 592                     , tm_internals_          :: (TcGblEnv, ModDetails)
 593                     }
 594
 595 instance ParsedMod TypecheckedModule where
 596   modSummary m   = modSummary (tm_parsed_module m)
 597   parsedSource m = parsedSource (tm_parsed_module m)
 598
 599 instance TypecheckedMod TypecheckedModule where
 600   renamedSource m     = tm_renamed_source m
 601   typecheckedSource m = tm_typechecked_source m
 602   moduleInfo m = tm_checked_module_info m
 603   tm_internals m      = tm_internals_ m
 604
 605 -- | The result of successful desugaring (i.e., translation to core).  Also
 606 --  contains all the information of a typechecked module.
 607 data DesugaredModule =
 608   DesugaredModule { dm_typechecked_module :: TypecheckedModule
 609                   , dm_core_module        :: ModGuts
 610              }
 611
 612 instance ParsedMod DesugaredModule where
 613   modSummary m   = modSummary (dm_typechecked_module m)
 614   parsedSource m = parsedSource (dm_typechecked_module m)
 615
 616 instance TypecheckedMod DesugaredModule where
 617   renamedSource m     = renamedSource (dm_typechecked_module m)
 618   typecheckedSource m = typecheckedSource (dm_typechecked_module m)
 619   moduleInfo m        = moduleInfo (dm_typechecked_module m)
 620   tm_internals m      = tm_internals_ (dm_typechecked_module m)
 621
 622 instance DesugaredMod DesugaredModule where
 623   coreModule m = dm_core_module m
 624
 625 type ParsedSource      = Located (HsModule RdrName)
 626 type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
 627                           Maybe LHsDocString)
 628 type TypecheckedSource = LHsBinds Id
 629
 630 -- NOTE:
 631 --   - things that aren't in the output of the typechecker right now:
 632 --     - the export list
 633 --     - the imports
 634 --     - type signatures
 635 --     - type/data/newtype declarations
 636 --     - class declarations
 637 --     - instances
 638 --   - extra things in the typechecker's output:
 639 --     - default methods are turned into top-level decls.
 640 --     - dictionary bindings
 641
 642 -- | Return the 'ModSummary' of a module with the given name.
 643 --
 644 -- The module must be part of the module graph (see 'hsc_mod_graph' and
 645 -- 'ModuleGraph').  If this is not the case, this function will throw a
 646 -- 'GhcApiError'.
 647 --
 648 -- This function ignores boot modules and requires that there is only one
 649 -- non-boot module with the given name.
 650 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
 651 getModSummary mod = do
 652    mg <- liftM hsc_mod_graph getSession
 653    case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
 654      [] -> throw $ mkApiErr (text "Module not part of module graph")
 655      [ms] -> return ms
 656      multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
 657
 658 -- | Parse a module.
 659 --
 660 -- Throws a 'SourceError' on parse error.
 661 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
 662 parseModule ms = do
 663    hsc_env <- getSession
 664    let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 665    rdr_module <- liftIO $ hscParse hsc_env_tmp ms
 666    return (ParsedModule ms rdr_module)
 667
 668 -- | Typecheck and rename a parsed module.
 669 --
 670 -- Throws a 'SourceError' if either fails.
 671 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
 672 typecheckModule pmod = do
 673  let ms = modSummary pmod
 674  hsc_env <- getSession
 675  let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 676  (tc_gbl_env, rn_info)
 677        <- liftIO $ hscTypecheckRename hsc_env_tmp ms (parsedSource pmod)
 678  details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
 679  return $
 680      TypecheckedModule {
 681        tm_internals_          = (tc_gbl_env, details),
 682        tm_parsed_module       = pmod,
 683        tm_renamed_source      = rn_info,
 684        tm_typechecked_source  = tcg_binds tc_gbl_env,
 685        tm_checked_module_info =
 686          ModuleInfo {
 687            minf_type_env  = md_types details,
 688            minf_exports   = availsToNameSet $ md_exports details,
 689            minf_rdr_env   = Just (tcg_rdr_env tc_gbl_env),
 690            minf_instances = md_insts details
 691 #ifdef GHCI
 692            ,minf_modBreaks = emptyModBreaks
 693 #endif
 694          }}
 695
 696 -- | Desugar a typechecked module.
 697 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
 698 desugarModule tcm = do
 699  let ms = modSummary tcm
 700  let (tcg, _) = tm_internals tcm
 701  hsc_env <- getSession
 702  let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 703  guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg
 704  return $
 705      DesugaredModule {
 706        dm_typechecked_module = tcm,
 707        dm_core_module        = guts
 708      }
 709
 710 -- | Load a module.  Input doesn't need to be desugared.
 711 --
 712 -- A module must be loaded before dependent modules can be typechecked.  This
 713 -- always includes generating a 'ModIface' and, depending on the
 714 -- 'DynFlags.hscTarget', may also include code generation.
 715 --
 716 -- This function will always cause recompilation and will always overwrite
 717 -- previous compilation results (potentially files on disk).
 718 --
 719 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
 720 loadModule tcm = do
 721    let ms = modSummary tcm
 722    let mod = ms_mod_name ms
 723    let loc = ms_location ms
 724    let (tcg, _details) = tm_internals tcm
 725
 726    mb_linkable <- case ms_obj_date ms of
 727                      Just t | t > ms_hs_date ms  -> do
 728                          l <- liftIO $ findObjectLinkable (ms_mod ms)
 729                                                   (ml_obj_file loc) t
 730                          return (Just l)
 731                      _otherwise -> return Nothing
 732
 733    -- compile doesn't change the session
 734    hsc_env <- getSession
 735    mod_info <- liftIO $ compile' (hscNothingBackendOnly     tcg,
 736                                   hscInteractiveBackendOnly tcg,
 737                                   hscBatchBackendOnly       tcg)
 738                                   hsc_env ms 1 1 Nothing mb_linkable
 739
 740    modifySession $ \e -> e{ hsc_HPT = addToUFM (hsc_HPT e) mod mod_info }
 741    return tcm
 742
 743
 744 -- %************************************************************************
 745 -- %*                                                                      *
 746 --             Dealing with Core
 747 -- %*                                                                      *
 748 -- %************************************************************************
 749
 750 -- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
 751 -- the 'GHC.compileToCoreModule' interface.
 752 data CoreModule
 753   = CoreModule {
 754       -- | Module name
 755       cm_module   :: !Module,
 756       -- | Type environment for types declared in this module
 757       cm_types    :: !TypeEnv,
 758       -- | Declarations
 759       cm_binds    :: [CoreBind],
 760       -- | Imports
 761       cm_imports  :: ![Module]
 762     }
 763
 764 instance Outputable CoreModule where
 765    ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb}) =
 766       text "%module" <+> ppr mn <+> ppr te $$ vcat (map ppr cb)
 767
 768 -- | This is the way to get access to the Core bindings corresponding
 769 -- to a module. 'compileToCore' parses, typechecks, and
 770 -- desugars the module, then returns the resulting Core module (consisting of
 771 -- the module name, type declarations, and function declarations) if
 772 -- successful.
 773 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
 774 compileToCoreModule = compileCore False
 775
 776 -- | Like compileToCoreModule, but invokes the simplifier, so
 777 -- as to return simplified and tidied Core.
 778 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
 779 compileToCoreSimplified = compileCore True
 780 {-
 781 -- | Provided for backwards-compatibility: compileToCore returns just the Core
 782 -- bindings, but for most purposes, you probably want to call
 783 -- compileToCoreModule.
 784 compileToCore :: GhcMonad m => FilePath -> m [CoreBind]
 785 compileToCore fn = do
 786    mod <- compileToCoreModule session fn
 787    return $ cm_binds mod
 788 -}
 789 -- | Takes a CoreModule and compiles the bindings therein
 790 -- to object code. The first argument is a bool flag indicating
 791 -- whether to run the simplifier.
 792 -- The resulting .o, .hi, and executable files, if any, are stored in the
 793 -- current directory, and named according to the module name.
 794 -- This has only so far been tested with a single self-contained module.
 795 compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
 796 compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
 797   dflags      <- getSessionDynFlags
 798   currentTime <- liftIO $ getClockTime
 799   cwd         <- liftIO $ getCurrentDirectory
 800   modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
 801                    ((moduleNameSlashes . moduleName) mName)
 802
 803   let modSummary = ModSummary { ms_mod = mName,
 804          ms_hsc_src = ExtCoreFile,
 805          ms_location = modLocation,
 806          -- By setting the object file timestamp to Nothing,
 807          -- we always force recompilation, which is what we
 808          -- want. (Thus it doesn't matter what the timestamp
 809          -- for the (nonexistent) source file is.)
 810          ms_hs_date = currentTime,
 811          ms_obj_date = Nothing,
 812          -- Only handling the single-module case for now, so no imports.
 813          ms_srcimps = [],
 814          ms_imps = [],
 815          -- No source file
 816          ms_hspp_file = "",
 817          ms_hspp_opts = dflags,
 818          ms_hspp_buf = Nothing
 819       }
 820
 821   hsc_env <- getSession
 822   liftIO $ hscCompileCore hsc_env simplify modSummary (cm_binds cm)
 823
 824
 825 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
 826 compileCore simplify fn = do
 827    -- First, set the target to the desired filename
 828    target <- guessTarget fn Nothing
 829    addTarget target
 830    _ <- load LoadAllTargets
 831    -- Then find dependencies
 832    modGraph <- depanal [] True
 833    case find ((== fn) . msHsFilePath) modGraph of
 834      Just modSummary -> do
 835        -- Now we have the module name;
 836        -- parse, typecheck and desugar the module
 837        mod_guts <- coreModule `fmap`
 838                       -- TODO: space leaky: call hsc* directly?
 839                       (desugarModule =<< typecheckModule =<< parseModule modSummary)
 840        liftM gutsToCoreModule $
 841          if simplify
 842           then do
 843              -- If simplify is true: simplify (hscSimplify), then tidy
 844              -- (tidyProgram).
 845              hsc_env <- getSession
 846              simpl_guts <- liftIO $ hscSimplify hsc_env mod_guts
 847              tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
 848              return $ Left tidy_guts
 849           else
 850              return $ Right mod_guts
 851
 852      Nothing -> panic "compileToCoreModule: target FilePath not found in\
 853                            module dependency graph"
 854   where -- two versions, based on whether we simplify (thus run tidyProgram,
 855         -- which returns a (CgGuts, ModDetails) pair, or not (in which case
 856         -- we just have a ModGuts.
 857         gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
 858         gutsToCoreModule (Left (cg, md))  = CoreModule {
 859           cm_module = cg_module cg,    cm_types = md_types md,
 860           cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
 861         }
 862         gutsToCoreModule (Right mg) = CoreModule {
 863           cm_module  = mg_module mg,                   cm_types   = mg_types mg,
 864           cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds   = mg_binds mg
 865          }
 866
 867 -- %************************************************************************
 868 -- %*                                                                      *
 869 --             Inspecting the session
 870 -- %*                                                                      *
 871 -- %************************************************************************
 872
 873 -- | Get the module dependency graph.
 874 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
 875 getModuleGraph = liftM hsc_mod_graph getSession
 876
 877 -- | Determines whether a set of modules requires Template Haskell.
 878 --
 879 -- Note that if the session's 'DynFlags' enabled Template Haskell when
 880 -- 'depanal' was called, then each module in the returned module graph will
 881 -- have Template Haskell enabled whether it is actually needed or not.
 882 needsTemplateHaskell :: ModuleGraph -> Bool
 883 needsTemplateHaskell ms =
 884     any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms
 885
 886 -- | Return @True@ <==> module is loaded.
 887 isLoaded :: GhcMonad m => ModuleName -> m Bool
 888 isLoaded m = withSession $ \hsc_env ->
 889   return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
 890
 891 -- | Return the bindings for the current interactive session.
 892 getBindings :: GhcMonad m => m [TyThing]
 893 getBindings = withSession $ \hsc_env ->
 894    -- we have to implement the shadowing behaviour of ic_tmp_ids here
 895    -- (see InteractiveContext) and the quickest way is to use an OccEnv.
 896    let
 897        occ_env = mkOccEnv [ (nameOccName (idName id), AnId id)
 898                           | id <- ic_tmp_ids (hsc_IC hsc_env) ]
 899    in
 900    return (occEnvElts occ_env)
 901
 902 getPrintUnqual :: GhcMonad m => m PrintUnqualified
 903 getPrintUnqual = withSession $ \hsc_env ->
 904   return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
 905
 906 -- | Container for information about a 'Module'.
 907 data ModuleInfo = ModuleInfo {
 908         minf_type_env  :: TypeEnv,
 909         minf_exports   :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
 910         minf_rdr_env   :: Maybe GlobalRdrEnv,   -- Nothing for a compiled/package mod
 911         minf_instances :: [Instance]
 912 #ifdef GHCI
 913         ,minf_modBreaks :: ModBreaks
 914 #endif
 915         -- ToDo: this should really contain the ModIface too
 916   }
 917         -- We don't want HomeModInfo here, because a ModuleInfo applies
 918         -- to package modules too.
 919
 920 -- | Request information about a loaded 'Module'
 921 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo)  -- XXX: Maybe X
 922 getModuleInfo mdl = withSession $ \hsc_env -> do
 923   let mg = hsc_mod_graph hsc_env
 924   if mdl `elem` map ms_mod mg
 925         then liftIO $ getHomeModuleInfo hsc_env (moduleName mdl)
 926         else do
 927   {- if isHomeModule (hsc_dflags hsc_env) mdl
 928         then return Nothing
 929         else -} liftIO $ getPackageModuleInfo hsc_env mdl
 930    -- getPackageModuleInfo will attempt to find the interface, so
 931    -- we don't want to call it for a home module, just in case there
 932    -- was a problem loading the module and the interface doesn't
 933    -- exist... hence the isHomeModule test here.  (ToDo: reinstate)
 934
 935 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
 936 #ifdef GHCI
 937 getPackageModuleInfo hsc_env mdl = do
 938   mb_avails <- hscGetModuleExports hsc_env mdl
 939   case mb_avails of
 940     Nothing -> return Nothing
 941     Just avails -> do
 942         eps <- readIORef (hsc_EPS hsc_env)
 943         let
 944             names  = availsToNameSet avails
 945             pte    = eps_PTE eps
 946             tys    = [ ty | name <- concatMap availNames avails,
 947                             Just ty <- [lookupTypeEnv pte name] ]
 948         --
 949         return (Just (ModuleInfo {
 950                         minf_type_env  = mkTypeEnv tys,
 951                         minf_exports   = names,
 952                         minf_rdr_env   = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
 953                         minf_instances = error "getModuleInfo: instances for package module unimplemented",
 954                         minf_modBreaks = emptyModBreaks
 955                 }))
 956 #else
 957 getPackageModuleInfo _hsc_env _mdl = do
 958   -- bogusly different for non-GHCI (ToDo)
 959   return Nothing
 960 #endif
 961
 962 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
 963 getHomeModuleInfo hsc_env mdl =
 964   case lookupUFM (hsc_HPT hsc_env) mdl of
 965     Nothing  -> return Nothing
 966     Just hmi -> do
 967       let details = hm_details hmi
 968       return (Just (ModuleInfo {
 969                         minf_type_env  = md_types details,
 970                         minf_exports   = availsToNameSet (md_exports details),
 971                         minf_rdr_env   = mi_globals $! hm_iface hmi,
 972                         minf_instances = md_insts details
 973 #ifdef GHCI
 974                        ,minf_modBreaks = getModBreaks hmi
 975 #endif
 976                         }))
 977
 978 -- | The list of top-level entities defined in a module
 979 modInfoTyThings :: ModuleInfo -> [TyThing]
 980 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
 981
 982 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
 983 modInfoTopLevelScope minf
 984   = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
 985
 986 modInfoExports :: ModuleInfo -> [Name]
 987 modInfoExports minf = nameSetToList $! minf_exports minf
 988
 989 -- | Returns the instances defined by the specified module.
 990 -- Warning: currently unimplemented for package modules.
 991 modInfoInstances :: ModuleInfo -> [Instance]
 992 modInfoInstances = minf_instances
 993
 994 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
 995 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
 996
 997 mkPrintUnqualifiedForModule :: GhcMonad m =>
 998                                ModuleInfo
 999                             -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
1000 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
1001   return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
1002
1003 modInfoLookupName :: GhcMonad m =>
1004                      ModuleInfo -> Name
1005                   -> m (Maybe TyThing) -- XXX: returns a Maybe X
1006 modInfoLookupName minf name = withSession $ \hsc_env -> do
1007    case lookupTypeEnv (minf_type_env minf) name of
1008      Just tyThing -> return (Just tyThing)
1009      Nothing      -> do
1010        eps <- liftIO $ readIORef (hsc_EPS hsc_env)
1011        return $! lookupType (hsc_dflags hsc_env)
1012                             (hsc_HPT hsc_env) (eps_PTE eps) name
1013
1014 #ifdef GHCI
1015 modInfoModBreaks :: ModuleInfo -> ModBreaks
1016 modInfoModBreaks = minf_modBreaks
1017 #endif
1018
1019 isDictonaryId :: Id -> Bool
1020 isDictonaryId id
1021   = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
1022
1023 -- | Looks up a global name: that is, any top-level name in any
1024 -- visible module.  Unlike 'lookupName', lookupGlobalName does not use
1025 -- the interactive context, and therefore does not require a preceding
1026 -- 'setContext'.
1027 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
1028 lookupGlobalName name = withSession $ \hsc_env -> do
1029    liftIO $ lookupTypeHscEnv hsc_env name
1030
1031 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
1032 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
1033     ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
1034     return (findAnns deserialize ann_env target)
1035
1036 #ifdef GHCI
1037 -- | get the GlobalRdrEnv for a session
1038 getGRE :: GhcMonad m => m GlobalRdrEnv
1039 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
1040 #endif
1041
1042 -- -----------------------------------------------------------------------------
1043
1044 -- | Return all /external/ modules available in the package database.
1045 -- Modules from the current session (i.e., from the 'HomePackageTable') are
1046 -- not included.
1047 packageDbModules :: GhcMonad m =>
1048                     Bool  -- ^ Only consider exposed packages.
1049                  -> m [Module]
1050 packageDbModules only_exposed = do
1051    dflags <- getSessionDynFlags
1052    let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
1053    return $
1054      [ mkModule pid modname | p <- pkgs
1055                             , not only_exposed || exposed p
1056                             , let pid = packageConfigId p
1057                             , modname <- exposedModules p ]
1058
1059 -- -----------------------------------------------------------------------------
1060 -- Misc exported utils
1061
1062 dataConType :: DataCon -> Type
1063 dataConType dc = idType (dataConWrapId dc)
1064
1065 -- | print a 'NamedThing', adding parentheses if the name is an operator.
1066 pprParenSymName :: NamedThing a => a -> SDoc
1067 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
1068
1069 -- ----------------------------------------------------------------------------
1070
1071 #if 0
1072
1073 -- ToDo:
1074 --   - Data and Typeable instances for HsSyn.
1075
1076 -- ToDo: check for small transformations that happen to the syntax in
1077 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1078
1079 -- ToDo: maybe use TH syntax instead of IfaceSyn?  There's already a way
1080 -- to get from TyCons, Ids etc. to TH syntax (reify).
1081
1082 -- :browse will use either lm_toplev or inspect lm_interface, depending
1083 -- on whether the module is interpreted or not.
1084
1085 #endif
1086
1087 -- Extract the filename, stringbuffer content and dynflags associed to a module
1088 --
1089 -- XXX: Explain pre-conditions
1090 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
1091 getModuleSourceAndFlags mod = do
1092   m <- getModSummary (moduleName mod)
1093   case ml_hs_file $ ms_location m of
1094     Nothing -> throw $ mkApiErr (text "No source available for module " <+> ppr mod)
1095     Just sourceFile -> do
1096         source <- liftIO $ hGetStringBuffer sourceFile
1097         return (sourceFile, source, ms_hspp_opts m)
1098
1099
1100 -- | Return module source as token stream, including comments.
1101 --
1102 -- The module must be in the module graph and its source must be available.
1103 -- Throws a 'HscTypes.SourceError' on parse error.
1104 getTokenStream :: GhcMonad m => Module -> m [Located Token]
1105 getTokenStream mod = do
1106   (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1107   let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
1108   case lexTokenStream source startLoc flags of
1109     POk _ ts  -> return ts
1110     PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
1111
1112 -- | Give even more information on the source than 'getTokenStream'
1113 -- This function allows reconstructing the source completely with
1114 -- 'showRichTokenStream'.
1115 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
1116 getRichTokenStream mod = do
1117   (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1118   let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
1119   case lexTokenStream source startLoc flags of
1120     POk _ ts -> return $ addSourceToTokens startLoc source ts
1121     PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
1122
1123 -- | Given a source location and a StringBuffer corresponding to this
1124 -- location, return a rich token stream with the source associated to the
1125 -- tokens.
1126 addSourceToTokens :: SrcLoc -> StringBuffer -> [Located Token]
1127                   -> [(Located Token, String)]
1128 addSourceToTokens _ _ [] = []
1129 addSourceToTokens loc buf (t@(L span _) : ts)
1130     | not (isGoodSrcSpan span) = (t,"") : addSourceToTokens loc buf ts
1131     | otherwise = (t,str) : addSourceToTokens newLoc newBuf ts
1132     where
1133       (newLoc, newBuf, str) = go "" loc buf
1134       start = srcSpanStart span
1135       end = srcSpanEnd span
1136       go acc loc buf | loc < start = go acc nLoc nBuf
1137                      | start <= loc && loc < end = go (ch:acc) nLoc nBuf
1138                      | otherwise = (loc, buf, reverse acc)
1139           where (ch, nBuf) = nextChar buf
1140                 nLoc = advanceSrcLoc loc ch
1141
1142
1143 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
1144 -- return source code almost identical to the original code (except for
1145 -- insignificant whitespace.)
1146 showRichTokenStream :: [(Located Token, String)] -> String
1147 showRichTokenStream ts = go startLoc ts ""
1148     where sourceFile = srcSpanFile (getLoc . fst . head $ ts)
1149           startLoc = mkSrcLoc sourceFile 1 1
1150           go _ [] = id
1151           go loc ((L span _, str):ts)
1152               | not (isGoodSrcSpan span) = go loc ts
1153               | locLine == tokLine = ((replicate (tokCol - locCol) ' ') ++)
1154                                      . (str ++)
1155                                      . go tokEnd ts
1156               | otherwise = ((replicate (tokLine - locLine) '\n') ++)
1157                             . ((replicate tokCol ' ') ++)
1158                             . (str ++)
1159                             . go tokEnd ts
1160               where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
1161                     (tokLine, tokCol) = (srcSpanStartLine span, srcSpanStartCol span)
1162                     tokEnd = srcSpanEnd span
1163
1164 -- -----------------------------------------------------------------------------
1165 -- Interactive evaluation
1166
1167 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
1168 -- filesystem and package database to find the corresponding 'Module',
1169 -- using the algorithm that is used for an @import@ declaration.
1170 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1171 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
1172   let
1173     dflags   = hsc_dflags hsc_env
1174     this_pkg = thisPackage dflags
1175   --
1176   case maybe_pkg of
1177     Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
1178       res <- findImportedModule hsc_env mod_name maybe_pkg
1179       case res of
1180         Found _ m -> return m
1181         err       -> noModError dflags noSrcSpan mod_name err
1182     _otherwise -> do
1183       home <- lookupLoadedHomeModule mod_name
1184       case home of
1185         Just m  -> return m
1186         Nothing -> liftIO $ do
1187            res <- findImportedModule hsc_env mod_name maybe_pkg
1188            case res of
1189              Found loc m | modulePackageId m /= this_pkg -> return m
1190                          | otherwise -> modNotLoadedError m loc
1191              err -> noModError dflags noSrcSpan mod_name err
1192
1193 modNotLoadedError :: Module -> ModLocation -> IO a
1194 modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $
1195    text "module is not loaded:" <+>
1196    quotes (ppr (moduleName m)) <+>
1197    parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
1198
1199 -- | Like 'findModule', but differs slightly when the module refers to
1200 -- a source file, and the file has not been loaded via 'load'.  In
1201 -- this case, 'findModule' will throw an error (module not loaded),
1202 -- but 'lookupModule' will check to see whether the module can also be
1203 -- found in a package, and if so, that package 'Module' will be
1204 -- returned.  If not, the usual module-not-found error will be thrown.
1205 --
1206 lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1207 lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
1208 lookupModule mod_name Nothing = withSession $ \hsc_env -> do
1209   home <- lookupLoadedHomeModule mod_name
1210   case home of
1211     Just m  -> return m
1212     Nothing -> liftIO $ do
1213       res <- findExposedPackageModule hsc_env mod_name Nothing
1214       case res of
1215         Found _ m -> return m
1216         err       -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
1217
1218 lookupLoadedHomeModule  :: GhcMonad m => ModuleName -> m (Maybe Module)
1219 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
1220   case lookupUFM (hsc_HPT hsc_env) mod_name of
1221     Just mod_info      -> return (Just (mi_module (hm_iface mod_info)))
1222     _not_a_home_module -> return Nothing
1223
1224 #ifdef GHCI
1225 getHistorySpan :: GhcMonad m => History -> m SrcSpan
1226 getHistorySpan h = withSession $ \hsc_env ->
1227                           return$ InteractiveEval.getHistorySpan hsc_env h
1228
1229 obtainTermFromVal :: GhcMonad m => Int ->  Bool -> Type -> a -> m Term
1230 obtainTermFromVal bound force ty a =
1231     withSession $ \hsc_env ->
1232       liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
1233
1234 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
1235 obtainTermFromId bound force id =
1236     withSession $ \hsc_env ->
1237       liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
1238
1239 #endif
1240
1241 -- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
1242 -- entity known to GHC, including 'Name's defined using 'runStmt'.
1243 lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
1244 lookupName name =
1245      withSession $ \hsc_env ->
1246        liftIO $ hscTcRcLookupName hsc_env name
1247
1248 -- -----------------------------------------------------------------------------
1249 -- Pure API
1250
1251 -- | A pure interface to the module parser.
1252 --
1253 parser :: String         -- ^ Haskell module source text (full Unicode is supported)
1254        -> DynFlags       -- ^ the flags
1255        -> FilePath       -- ^ the filename (for source locations)
1256        -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
1257
1258 parser str dflags filename =
1259    let
1260        loc  = mkSrcLoc (mkFastString filename) 1 1
1261        buf  = stringToStringBuffer str
1262    in
1263    case unP Parser.parseModule (mkPState dflags buf loc) of
1264
1265      PFailed span err   ->
1266          Left (unitBag (mkPlainErrMsg span err))
1267
1268      POk pst rdr_module ->
1269          let (warns,_) = getMessages pst in
1270          Right (warns, rdr_module)