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