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   mySettings <- liftIO $ initSysTools mb_top_dir
 435   dflags <- liftIO $ initDynFlags (defaultDynFlags mySettings)
 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     }
 761
 762 instance Outputable CoreModule where
 763    ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb}) =
 764       text "%module" <+> ppr mn <+> ppr te $$ vcat (map ppr cb)
 765
 766 -- | This is the way to get access to the Core bindings corresponding
 767 -- to a module. 'compileToCore' parses, typechecks, and
 768 -- desugars the module, then returns the resulting Core module (consisting of
 769 -- the module name, type declarations, and function declarations) if
 770 -- successful.
 771 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
 772 compileToCoreModule = compileCore False
 773
 774 -- | Like compileToCoreModule, but invokes the simplifier, so
 775 -- as to return simplified and tidied Core.
 776 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
 777 compileToCoreSimplified = compileCore True
 778 {-
 779 -- | Provided for backwards-compatibility: compileToCore returns just the Core
 780 -- bindings, but for most purposes, you probably want to call
 781 -- compileToCoreModule.
 782 compileToCore :: GhcMonad m => FilePath -> m [CoreBind]
 783 compileToCore fn = do
 784    mod <- compileToCoreModule session fn
 785    return $ cm_binds mod
 786 -}
 787 -- | Takes a CoreModule and compiles the bindings therein
 788 -- to object code. The first argument is a bool flag indicating
 789 -- whether to run the simplifier.
 790 -- The resulting .o, .hi, and executable files, if any, are stored in the
 791 -- current directory, and named according to the module name.
 792 -- This has only so far been tested with a single self-contained module.
 793 compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
 794 compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
 795   dflags      <- getSessionDynFlags
 796   currentTime <- liftIO $ getClockTime
 797   cwd         <- liftIO $ getCurrentDirectory
 798   modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
 799                    ((moduleNameSlashes . moduleName) mName)
 800
 801   let modSummary = ModSummary { ms_mod = mName,
 802          ms_hsc_src = ExtCoreFile,
 803          ms_location = modLocation,
 804          -- By setting the object file timestamp to Nothing,
 805          -- we always force recompilation, which is what we
 806          -- want. (Thus it doesn't matter what the timestamp
 807          -- for the (nonexistent) source file is.)
 808          ms_hs_date = currentTime,
 809          ms_obj_date = Nothing,
 810          -- Only handling the single-module case for now, so no imports.
 811          ms_srcimps = [],
 812          ms_imps = [],
 813          -- No source file
 814          ms_hspp_file = "",
 815          ms_hspp_opts = dflags,
 816          ms_hspp_buf = Nothing
 817       }
 818
 819   hsc_env <- getSession
 820   liftIO $ hscCompileCore hsc_env simplify modSummary (cm_binds cm)
 821
 822
 823 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
 824 compileCore simplify fn = do
 825    -- First, set the target to the desired filename
 826    target <- guessTarget fn Nothing
 827    addTarget target
 828    _ <- load LoadAllTargets
 829    -- Then find dependencies
 830    modGraph <- depanal [] True
 831    case find ((== fn) . msHsFilePath) modGraph of
 832      Just modSummary -> do
 833        -- Now we have the module name;
 834        -- parse, typecheck and desugar the module
 835        mod_guts <- coreModule `fmap`
 836                       -- TODO: space leaky: call hsc* directly?
 837                       (desugarModule =<< typecheckModule =<< parseModule modSummary)
 838        liftM gutsToCoreModule $
 839          if simplify
 840           then do
 841              -- If simplify is true: simplify (hscSimplify), then tidy
 842              -- (tidyProgram).
 843              hsc_env <- getSession
 844              simpl_guts <- liftIO $ hscSimplify hsc_env mod_guts
 845              tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
 846              return $ Left tidy_guts
 847           else
 848              return $ Right mod_guts
 849
 850      Nothing -> panic "compileToCoreModule: target FilePath not found in\
 851                            module dependency graph"
 852   where -- two versions, based on whether we simplify (thus run tidyProgram,
 853         -- which returns a (CgGuts, ModDetails) pair, or not (in which case
 854         -- we just have a ModGuts.
 855         gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
 856         gutsToCoreModule (Left (cg, md))  = CoreModule {
 857           cm_module = cg_module cg,    cm_types = md_types md,
 858           cm_binds = cg_binds cg
 859         }
 860         gutsToCoreModule (Right mg) = CoreModule {
 861           cm_module  = mg_module mg,                   cm_types   = mg_types mg,
 862           cm_binds   = mg_binds mg
 863          }
 864
 865 -- %************************************************************************
 866 -- %*                                                                      *
 867 --             Inspecting the session
 868 -- %*                                                                      *
 869 -- %************************************************************************
 870
 871 -- | Get the module dependency graph.
 872 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
 873 getModuleGraph = liftM hsc_mod_graph getSession
 874
 875 -- | Determines whether a set of modules requires Template Haskell.
 876 --
 877 -- Note that if the session's 'DynFlags' enabled Template Haskell when
 878 -- 'depanal' was called, then each module in the returned module graph will
 879 -- have Template Haskell enabled whether it is actually needed or not.
 880 needsTemplateHaskell :: ModuleGraph -> Bool
 881 needsTemplateHaskell ms =
 882     any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms
 883
 884 -- | Return @True@ <==> module is loaded.
 885 isLoaded :: GhcMonad m => ModuleName -> m Bool
 886 isLoaded m = withSession $ \hsc_env ->
 887   return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
 888
 889 -- | Return the bindings for the current interactive session.
 890 getBindings :: GhcMonad m => m [TyThing]
 891 getBindings = withSession $ \hsc_env ->
 892    -- we have to implement the shadowing behaviour of ic_tmp_ids here
 893    -- (see InteractiveContext) and the quickest way is to use an OccEnv.
 894    let
 895        occ_env = mkOccEnv [ (nameOccName (idName id), AnId id)
 896                           | id <- ic_tmp_ids (hsc_IC hsc_env) ]
 897    in
 898    return (occEnvElts occ_env)
 899
 900 getPrintUnqual :: GhcMonad m => m PrintUnqualified
 901 getPrintUnqual = withSession $ \hsc_env ->
 902   return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
 903
 904 -- | Container for information about a 'Module'.
 905 data ModuleInfo = ModuleInfo {
 906         minf_type_env  :: TypeEnv,
 907         minf_exports   :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
 908         minf_rdr_env   :: Maybe GlobalRdrEnv,   -- Nothing for a compiled/package mod
 909         minf_instances :: [Instance]
 910 #ifdef GHCI
 911         ,minf_modBreaks :: ModBreaks
 912 #endif
 913         -- ToDo: this should really contain the ModIface too
 914   }
 915         -- We don't want HomeModInfo here, because a ModuleInfo applies
 916         -- to package modules too.
 917
 918 -- | Request information about a loaded 'Module'
 919 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo)  -- XXX: Maybe X
 920 getModuleInfo mdl = withSession $ \hsc_env -> do
 921   let mg = hsc_mod_graph hsc_env
 922   if mdl `elem` map ms_mod mg
 923         then liftIO $ getHomeModuleInfo hsc_env (moduleName mdl)
 924         else do
 925   {- if isHomeModule (hsc_dflags hsc_env) mdl
 926         then return Nothing
 927         else -} liftIO $ getPackageModuleInfo hsc_env mdl
 928    -- getPackageModuleInfo will attempt to find the interface, so
 929    -- we don't want to call it for a home module, just in case there
 930    -- was a problem loading the module and the interface doesn't
 931    -- exist... hence the isHomeModule test here.  (ToDo: reinstate)
 932
 933 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
 934 #ifdef GHCI
 935 getPackageModuleInfo hsc_env mdl = do
 936   mb_avails <- hscGetModuleExports hsc_env mdl
 937   case mb_avails of
 938     Nothing -> return Nothing
 939     Just avails -> do
 940         eps <- readIORef (hsc_EPS hsc_env)
 941         let
 942             names  = availsToNameSet avails
 943             pte    = eps_PTE eps
 944             tys    = [ ty | name <- concatMap availNames avails,
 945                             Just ty <- [lookupTypeEnv pte name] ]
 946         --
 947         return (Just (ModuleInfo {
 948                         minf_type_env  = mkTypeEnv tys,
 949                         minf_exports   = names,
 950                         minf_rdr_env   = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
 951                         minf_instances = error "getModuleInfo: instances for package module unimplemented",
 952                         minf_modBreaks = emptyModBreaks
 953                 }))
 954 #else
 955 getPackageModuleInfo _hsc_env _mdl = do
 956   -- bogusly different for non-GHCI (ToDo)
 957   return Nothing
 958 #endif
 959
 960 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
 961 getHomeModuleInfo hsc_env mdl =
 962   case lookupUFM (hsc_HPT hsc_env) mdl of
 963     Nothing  -> return Nothing
 964     Just hmi -> do
 965       let details = hm_details hmi
 966       return (Just (ModuleInfo {
 967                         minf_type_env  = md_types details,
 968                         minf_exports   = availsToNameSet (md_exports details),
 969                         minf_rdr_env   = mi_globals $! hm_iface hmi,
 970                         minf_instances = md_insts details
 971 #ifdef GHCI
 972                        ,minf_modBreaks = getModBreaks hmi
 973 #endif
 974                         }))
 975
 976 -- | The list of top-level entities defined in a module
 977 modInfoTyThings :: ModuleInfo -> [TyThing]
 978 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
 979
 980 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
 981 modInfoTopLevelScope minf
 982   = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
 983
 984 modInfoExports :: ModuleInfo -> [Name]
 985 modInfoExports minf = nameSetToList $! minf_exports minf
 986
 987 -- | Returns the instances defined by the specified module.
 988 -- Warning: currently unimplemented for package modules.
 989 modInfoInstances :: ModuleInfo -> [Instance]
 990 modInfoInstances = minf_instances
 991
 992 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
 993 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
 994
 995 mkPrintUnqualifiedForModule :: GhcMonad m =>
 996                                ModuleInfo
 997                             -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
 998 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
 999   return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
1000
1001 modInfoLookupName :: GhcMonad m =>
1002                      ModuleInfo -> Name
1003                   -> m (Maybe TyThing) -- XXX: returns a Maybe X
1004 modInfoLookupName minf name = withSession $ \hsc_env -> do
1005    case lookupTypeEnv (minf_type_env minf) name of
1006      Just tyThing -> return (Just tyThing)
1007      Nothing      -> do
1008        eps <- liftIO $ readIORef (hsc_EPS hsc_env)
1009        return $! lookupType (hsc_dflags hsc_env)
1010                             (hsc_HPT hsc_env) (eps_PTE eps) name
1011
1012 #ifdef GHCI
1013 modInfoModBreaks :: ModuleInfo -> ModBreaks
1014 modInfoModBreaks = minf_modBreaks
1015 #endif
1016
1017 isDictonaryId :: Id -> Bool
1018 isDictonaryId id
1019   = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
1020
1021 -- | Looks up a global name: that is, any top-level name in any
1022 -- visible module.  Unlike 'lookupName', lookupGlobalName does not use
1023 -- the interactive context, and therefore does not require a preceding
1024 -- 'setContext'.
1025 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
1026 lookupGlobalName name = withSession $ \hsc_env -> do
1027    liftIO $ lookupTypeHscEnv hsc_env name
1028
1029 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
1030 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
1031     ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
1032     return (findAnns deserialize ann_env target)
1033
1034 #ifdef GHCI
1035 -- | get the GlobalRdrEnv for a session
1036 getGRE :: GhcMonad m => m GlobalRdrEnv
1037 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
1038 #endif
1039
1040 -- -----------------------------------------------------------------------------
1041
1042 -- | Return all /external/ modules available in the package database.
1043 -- Modules from the current session (i.e., from the 'HomePackageTable') are
1044 -- not included.
1045 packageDbModules :: GhcMonad m =>
1046                     Bool  -- ^ Only consider exposed packages.
1047                  -> m [Module]
1048 packageDbModules only_exposed = do
1049    dflags <- getSessionDynFlags
1050    let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
1051    return $
1052      [ mkModule pid modname | p <- pkgs
1053                             , not only_exposed || exposed p
1054                             , let pid = packageConfigId p
1055                             , modname <- exposedModules p ]
1056
1057 -- -----------------------------------------------------------------------------
1058 -- Misc exported utils
1059
1060 dataConType :: DataCon -> Type
1061 dataConType dc = idType (dataConWrapId dc)
1062
1063 -- | print a 'NamedThing', adding parentheses if the name is an operator.
1064 pprParenSymName :: NamedThing a => a -> SDoc
1065 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
1066
1067 -- ----------------------------------------------------------------------------
1068
1069 #if 0
1070
1071 -- ToDo:
1072 --   - Data and Typeable instances for HsSyn.
1073
1074 -- ToDo: check for small transformations that happen to the syntax in
1075 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1076
1077 -- ToDo: maybe use TH syntax instead of IfaceSyn?  There's already a way
1078 -- to get from TyCons, Ids etc. to TH syntax (reify).
1079
1080 -- :browse will use either lm_toplev or inspect lm_interface, depending
1081 -- on whether the module is interpreted or not.
1082
1083 #endif
1084
1085 -- Extract the filename, stringbuffer content and dynflags associed to a module
1086 --
1087 -- XXX: Explain pre-conditions
1088 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
1089 getModuleSourceAndFlags mod = do
1090   m <- getModSummary (moduleName mod)
1091   case ml_hs_file $ ms_location m of
1092     Nothing -> throw $ mkApiErr (text "No source available for module " <+> ppr mod)
1093     Just sourceFile -> do
1094         source <- liftIO $ hGetStringBuffer sourceFile
1095         return (sourceFile, source, ms_hspp_opts m)
1096
1097
1098 -- | Return module source as token stream, including comments.
1099 --
1100 -- The module must be in the module graph and its source must be available.
1101 -- Throws a 'HscTypes.SourceError' on parse error.
1102 getTokenStream :: GhcMonad m => Module -> m [Located Token]
1103 getTokenStream mod = do
1104   (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1105   let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
1106   case lexTokenStream source startLoc flags of
1107     POk _ ts  -> return ts
1108     PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
1109
1110 -- | Give even more information on the source than 'getTokenStream'
1111 -- This function allows reconstructing the source completely with
1112 -- 'showRichTokenStream'.
1113 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
1114 getRichTokenStream mod = do
1115   (sourceFile, source, flags) <- getModuleSourceAndFlags mod
1116   let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
1117   case lexTokenStream source startLoc flags of
1118     POk _ ts -> return $ addSourceToTokens startLoc source ts
1119     PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
1120
1121 -- | Given a source location and a StringBuffer corresponding to this
1122 -- location, return a rich token stream with the source associated to the
1123 -- tokens.
1124 addSourceToTokens :: SrcLoc -> StringBuffer -> [Located Token]
1125                   -> [(Located Token, String)]
1126 addSourceToTokens _ _ [] = []
1127 addSourceToTokens loc buf (t@(L span _) : ts)
1128     | not (isGoodSrcSpan span) = (t,"") : addSourceToTokens loc buf ts
1129     | otherwise = (t,str) : addSourceToTokens newLoc newBuf ts
1130     where
1131       (newLoc, newBuf, str) = go "" loc buf
1132       start = srcSpanStart span
1133       end = srcSpanEnd span
1134       go acc loc buf | loc < start = go acc nLoc nBuf
1135                      | start <= loc && loc < end = go (ch:acc) nLoc nBuf
1136                      | otherwise = (loc, buf, reverse acc)
1137           where (ch, nBuf) = nextChar buf
1138                 nLoc = advanceSrcLoc loc ch
1139
1140
1141 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
1142 -- return source code almost identical to the original code (except for
1143 -- insignificant whitespace.)
1144 showRichTokenStream :: [(Located Token, String)] -> String
1145 showRichTokenStream ts = go startLoc ts ""
1146     where sourceFile = srcSpanFile (getLoc . fst . head $ ts)
1147           startLoc = mkSrcLoc sourceFile 1 1
1148           go _ [] = id
1149           go loc ((L span _, str):ts)
1150               | not (isGoodSrcSpan span) = go loc ts
1151               | locLine == tokLine = ((replicate (tokCol - locCol) ' ') ++)
1152                                      . (str ++)
1153                                      . go tokEnd ts
1154               | otherwise = ((replicate (tokLine - locLine) '\n') ++)
1155                             . ((replicate tokCol ' ') ++)
1156                             . (str ++)
1157                             . go tokEnd ts
1158               where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
1159                     (tokLine, tokCol) = (srcSpanStartLine span, srcSpanStartCol span)
1160                     tokEnd = srcSpanEnd span
1161
1162 -- -----------------------------------------------------------------------------
1163 -- Interactive evaluation
1164
1165 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
1166 -- filesystem and package database to find the corresponding 'Module',
1167 -- using the algorithm that is used for an @import@ declaration.
1168 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1169 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
1170   let
1171     dflags   = hsc_dflags hsc_env
1172     this_pkg = thisPackage dflags
1173   --
1174   case maybe_pkg of
1175     Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
1176       res <- findImportedModule hsc_env mod_name maybe_pkg
1177       case res of
1178         Found _ m -> return m
1179         err       -> noModError dflags noSrcSpan mod_name err
1180     _otherwise -> do
1181       home <- lookupLoadedHomeModule mod_name
1182       case home of
1183         Just m  -> return m
1184         Nothing -> liftIO $ do
1185            res <- findImportedModule hsc_env mod_name maybe_pkg
1186            case res of
1187              Found loc m | modulePackageId m /= this_pkg -> return m
1188                          | otherwise -> modNotLoadedError m loc
1189              err -> noModError dflags noSrcSpan mod_name err
1190
1191 modNotLoadedError :: Module -> ModLocation -> IO a
1192 modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $
1193    text "module is not loaded:" <+>
1194    quotes (ppr (moduleName m)) <+>
1195    parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
1196
1197 -- | Like 'findModule', but differs slightly when the module refers to
1198 -- a source file, and the file has not been loaded via 'load'.  In
1199 -- this case, 'findModule' will throw an error (module not loaded),
1200 -- but 'lookupModule' will check to see whether the module can also be
1201 -- found in a package, and if so, that package 'Module' will be
1202 -- returned.  If not, the usual module-not-found error will be thrown.
1203 --
1204 lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
1205 lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
1206 lookupModule mod_name Nothing = withSession $ \hsc_env -> do
1207   home <- lookupLoadedHomeModule mod_name
1208   case home of
1209     Just m  -> return m
1210     Nothing -> liftIO $ do
1211       res <- findExposedPackageModule hsc_env mod_name Nothing
1212       case res of
1213         Found _ m -> return m
1214         err       -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
1215
1216 lookupLoadedHomeModule  :: GhcMonad m => ModuleName -> m (Maybe Module)
1217 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
1218   case lookupUFM (hsc_HPT hsc_env) mod_name of
1219     Just mod_info      -> return (Just (mi_module (hm_iface mod_info)))
1220     _not_a_home_module -> return Nothing
1221
1222 #ifdef GHCI
1223 getHistorySpan :: GhcMonad m => History -> m SrcSpan
1224 getHistorySpan h = withSession $ \hsc_env ->
1225                           return$ InteractiveEval.getHistorySpan hsc_env h
1226
1227 obtainTermFromVal :: GhcMonad m => Int ->  Bool -> Type -> a -> m Term
1228 obtainTermFromVal bound force ty a =
1229     withSession $ \hsc_env ->
1230       liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
1231
1232 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
1233 obtainTermFromId bound force id =
1234     withSession $ \hsc_env ->
1235       liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
1236
1237 #endif
1238
1239 -- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
1240 -- entity known to GHC, including 'Name's defined using 'runStmt'.
1241 lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
1242 lookupName name =
1243      withSession $ \hsc_env ->
1244        liftIO $ hscTcRcLookupName hsc_env name
1245
1246 -- -----------------------------------------------------------------------------
1247 -- Pure API
1248
1249 -- | A pure interface to the module parser.
1250 --
1251 parser :: String         -- ^ Haskell module source text (full Unicode is supported)
1252        -> DynFlags       -- ^ the flags
1253        -> FilePath       -- ^ the filename (for source locations)
1254        -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
1255
1256 parser str dflags filename =
1257    let
1258        loc  = mkSrcLoc (mkFastString filename) 1 1
1259        buf  = stringToStringBuffer str
1260    in
1261    case unP Parser.parseModule (mkPState dflags buf loc) of
1262
1263      PFailed span err   ->
1264          Left (unitBag (mkPlainErrMsg span err))
1265
1266      POk pst rdr_module ->
1267          let (warns,_) = getMessages pst in
1268          Right (warns, rdr_module)