compiler/main/GHC.hs

   1 -- -----------------------------------------------------------------------------
   2 --
   3 -- (c) The University of Glasgow, 2005
   4 --
   5 -- The GHC API
   6 --
   7 -- -----------------------------------------------------------------------------
   8
   9 module GHC (
  10         -- * Initialisation
  11         defaultErrorHandler,
  12         defaultCleanupHandler,
  13
  14         -- * GHC Monad
  15         Ghc, GhcT, GhcMonad(..),
  16         runGhc, runGhcT, initGhcMonad,
  17         gcatch, gbracket, gfinally,
  18         printException,
  19         printExceptionAndWarnings,
  20         handleSourceError,
  21         needsTemplateHaskell,
  22
  23         -- * Flags and settings
  24         DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
  25         GhcMode(..), GhcLink(..), defaultObjectTarget,
  26         parseDynamicFlags,
  27         getSessionDynFlags,
  28         setSessionDynFlags,
  29         parseStaticFlags,
  30
  31         -- * Targets
  32         Target(..), TargetId(..), Phase,
  33         setTargets,
  34         getTargets,
  35         addTarget,
  36         removeTarget,
  37         guessTarget,
  38
  39         -- * Loading\/compiling the program
  40         depanal,
  41         load, LoadHowMuch(..),
  42         SuccessFlag(..), succeeded, failed,
  43         defaultWarnErrLogger, WarnErrLogger,
  44         workingDirectoryChanged,
  45         parseModule, typecheckModule, desugarModule, loadModule,
  46         ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),
  47         TypecheckedSource, ParsedSource, RenamedSource,   -- ditto
  48         TypecheckedMod, ParsedMod,
  49         moduleInfo, renamedSource, typecheckedSource,
  50         parsedSource, coreModule,
  51         compileToCoreModule, compileToCoreSimplified,
  52         compileCoreToObj,
  53         getModSummary,
  54
  55         -- * Inspecting the module structure of the program
  56         ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
  57         getModuleGraph,
  58         isLoaded,
  59         topSortModuleGraph,
  60
  61         -- * Inspecting modules
  62         ModuleInfo,
  63         getModuleInfo,
  64         modInfoTyThings,
  65         modInfoTopLevelScope,
  66         modInfoExports,
  67         modInfoInstances,
  68         modInfoIsExportedName,
  69         modInfoLookupName,
  70         lookupGlobalName,
  71         findGlobalAnns,
  72         mkPrintUnqualifiedForModule,
  73
  74         -- * Querying the environment
  75         packageDbModules,
  76
  77         -- * Printing
  78         PrintUnqualified, alwaysQualify,
  79
  80         -- * Interactive evaluation
  81         getBindings, getPrintUnqual,
  82         findModule,
  83         lookupModule,
  84 #ifdef GHCI
  85         setContext, getContext,
  86         getNamesInScope,
  87         getRdrNamesInScope,
  88         getGRE,
  89         moduleIsInterpreted,
  90         getInfo,
  91         exprType,
  92         typeKind,
  93         parseName,
  94         RunResult(..),
  95         runStmt, runStmtWithLocation,
  96         parseImportDecl, SingleStep(..),
  97         resume,
  98         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
  99                resumeHistory, resumeHistoryIx),
 100         History(historyBreakInfo, historyEnclosingDecls),
 101         GHC.getHistorySpan, getHistoryModule,
 102         getResumeContext,
 103         abandon, abandonAll,
 104         InteractiveEval.back,
 105         InteractiveEval.forward,
 106         showModule,
 107         isModuleInterpreted,
 108         InteractiveEval.compileExpr, HValue, dynCompileExpr,
 109         GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
 110         modInfoModBreaks,
 111         ModBreaks(..), BreakIndex,
 112         BreakInfo(breakInfo_number, breakInfo_module),
 113         BreakArray, setBreakOn, setBreakOff, getBreak,
 114 #endif
 115         lookupName,
 116
 117         -- * Abstract syntax elements
 118
 119         -- ** Packages
 120         PackageId,
 121
 122         -- ** Modules
 123         Module, mkModule, pprModule, moduleName, modulePackageId,
 124         ModuleName, mkModuleName, moduleNameString,
 125
 126         -- ** Names
 127         Name,
 128         isExternalName, nameModule, pprParenSymName, nameSrcSpan,
 129         NamedThing(..),
 130         RdrName(Qual,Unqual),
 131
 132         -- ** Identifiers
 133         Id, idType,
 134         isImplicitId, isDeadBinder,
 135         isExportedId, isLocalId, isGlobalId,
 136         isRecordSelector,
 137         isPrimOpId, isFCallId, isClassOpId_maybe,
 138         isDataConWorkId, idDataCon,
 139         isBottomingId, isDictonaryId,
 140         recordSelectorFieldLabel,
 141
 142         -- ** Type constructors
 143         TyCon,
 144         tyConTyVars, tyConDataCons, tyConArity,
 145         isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
 146         isFamilyTyCon,
 147         synTyConDefn, synTyConType, synTyConResKind,
 148
 149         -- ** Type variables
 150         TyVar,
 151         alphaTyVars,
 152
 153         -- ** Data constructors
 154         DataCon,
 155         dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
 156         dataConIsInfix, isVanillaDataCon, dataConUserType,
 157         dataConStrictMarks,
 158         StrictnessMark(..), isMarkedStrict,
 159
 160         -- ** Classes
 161         Class,
 162         classMethods, classSCTheta, classTvsFds,
 163         pprFundeps,
 164
 165         -- ** Instances
 166         Instance,
 167         instanceDFunId, pprInstance, pprInstanceHdr,
 168
 169         -- ** Types and Kinds
 170         Type, splitForAllTys, funResultTy,
 171         pprParendType, pprTypeApp,
 172         Kind,
 173         PredType,
 174         ThetaType, pprForAll, pprThetaArrow,
 175
 176         -- ** Entities
 177         TyThing(..),
 178
 179         -- ** Syntax
 180         module HsSyn, -- ToDo: remove extraneous bits
 181
 182         -- ** Fixities
 183         FixityDirection(..),
 184         defaultFixity, maxPrecedence,
 185         negateFixity,
 186         compareFixity,
 187
 188         -- ** Source locations
 189         SrcLoc, pprDefnLoc,
 190         mkSrcLoc, isGoodSrcLoc, noSrcLoc,
 191         srcLocFile, srcLocLine, srcLocCol,
 192         SrcSpan,
 193         mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
 194         srcSpanStart, srcSpanEnd,
 195         srcSpanFile,
 196         srcSpanStartLine, srcSpanEndLine,
 197         srcSpanStartCol, srcSpanEndCol,
 198
 199         -- ** Located
 200         Located(..),
 201
 202         -- *** Constructing Located
 203         noLoc, mkGeneralLocated,
 204
 205         -- *** Deconstructing Located
 206         getLoc, unLoc,
 207
 208         -- *** Combining and comparing Located values
 209         eqLocated, cmpLocated, combineLocs, addCLoc,
 210         leftmost_smallest, leftmost_largest, rightmost,
 211         spans, isSubspanOf,
 212
 213         -- * Exceptions
 214         GhcException(..), showGhcException,
 215
 216         -- * Token stream manipulations
 217         Token,
 218         getTokenStream, getRichTokenStream,
 219         showRichTokenStream, addSourceToTokens,
 220
 221         -- * Pure interface to the parser
 222         parser,
 223
 224         -- * Miscellaneous
 225         --sessionHscEnv,
 226         cyclicModuleErr,
 227   ) where
 228
 229 {-
 230  ToDo:
 231
 232   * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
 233   * what StaticFlags should we expose, if any?
 234 -}
 235
 236 #include "HsVersions.h"
 237
 238 #ifdef GHCI
 239 import Linker           ( HValue )
 240 import ByteCodeInstr
 241 import BreakArray
 242 import InteractiveEval
 243 #endif
 244
 245 import HscMain
 246 import GhcMake
 247 import DriverPipeline   ( compile' )
 248 import GhcMonad
 249 import TcRnTypes
 250 import Packages
 251 import NameSet
 252 import RdrName
 253 import qualified HsSyn -- hack as we want to reexport the whole module
 254 import HsSyn hiding ((<.>))
 255 import Type
 256 import Coercion         ( synTyConResKind )
 257 import TcType           hiding( typeKind )
 258 import Id
 259 import Var
 260 import TysPrim          ( alphaTyVars )
 261 import TyCon
 262 import Class
 263 -- import FunDeps
 264 import DataCon
 265 import Name             hiding ( varName )
 266 -- import OccName               ( parenSymOcc )
 267 import InstEnv
 268 import SrcLoc
 269 import CoreSyn          ( CoreBind )
 270 import TidyPgm
 271 import DriverPhases     ( Phase(..), isHaskellSrcFilename )
 272 import Finder
 273 import HscTypes
 274 import DynFlags
 275 import StaticFlagParser
 276 import qualified StaticFlags
 277 import SysTools     ( initSysTools, cleanTempFiles,
 278                       cleanTempDirs )
 279 import Annotations
 280 import Module
 281 import UniqFM
 282 import Panic
 283 import Bag              ( unitBag )
 284 import ErrUtils
 285 import MonadUtils
 286 import Util
 287 import StringBuffer
 288 import Outputable
 289 import BasicTypes
 290 import Maybes           ( expectJust )
 291 import FastString
 292 import qualified Parser
 293 import Lexer
 294
 295 import System.Directory ( doesFileExist, getCurrentDirectory )
 296 import Data.Maybe
 297 import Data.List        ( find )
 298 import Data.Typeable    ( Typeable )
 299 import Data.Word        ( Word8 )
 300 import Control.Monad
 301 import System.Exit      ( exitWith, ExitCode(..) )
 302 import System.Time      ( getClockTime )
 303 import Exception
 304 import Data.IORef
 305 import System.FilePath
 306 import System.IO
 307 import Prelude hiding (init)
 308
 309
 310 -- %************************************************************************
 311 -- %*                                                                      *
 312 --             Initialisation: exception handlers
 313 -- %*                                                                      *
 314 -- %************************************************************************
 315
 316
 317 -- | Install some default exception handlers and run the inner computation.
 318 -- Unless you want to handle exceptions yourself, you should wrap this around
 319 -- the top level of your program.  The default handlers output the error
 320 -- message(s) to stderr and exit cleanly.
 321 defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
 322 defaultErrorHandler dflags inner =
 323   -- top-level exception handler: any unrecognised exception is a compiler bug.
 324   ghandle (\exception -> liftIO $ do
 325            hFlush stdout
 326            case fromException exception of
 327                 -- an IO exception probably isn't our fault, so don't panic
 328                 Just (ioe :: IOException) ->
 329                   fatalErrorMsg dflags (text (show ioe))
 330                 _ -> case fromException exception of
 331                      Just UserInterrupt -> exitWith (ExitFailure 1)
 332                      Just StackOverflow ->
 333                          fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
 334                      _ -> case fromException exception of
 335                           Just (ex :: ExitCode) -> throw ex
 336                           _ ->
 337                               fatalErrorMsg dflags
 338                                   (text (show (Panic (show exception))))
 339            exitWith (ExitFailure 1)
 340          ) $
 341
 342   -- error messages propagated as exceptions
 343   handleGhcException
 344             (\ge -> liftIO $ do
 345                 hFlush stdout
 346                 case ge of
 347                      PhaseFailed _ code -> exitWith code
 348                      Signal _ -> exitWith (ExitFailure 1)
 349                      _ -> do fatalErrorMsg dflags (text (show ge))
 350                              exitWith (ExitFailure 1)
 351             ) $
 352   inner
 353
 354 -- | Install a default cleanup handler to remove temporary files deposited by
 355 -- a GHC run.  This is seperate from 'defaultErrorHandler', because you might
 356 -- want to override the error handling, but still get the ordinary cleanup
 357 -- behaviour.
 358 defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
 359                          DynFlags -> m a -> m a
 360 defaultCleanupHandler dflags inner =
 361     -- make sure we clean up after ourselves
 362     inner `gfinally`
 363           (liftIO $ do
 364               cleanTempFiles dflags
 365               cleanTempDirs dflags
 366           )
 367           --  exceptions will be blocked while we clean the temporary files,
 368           -- so there shouldn't be any difficulty if we receive further
 369           -- signals.
 370
 371
 372 -- %************************************************************************
 373 -- %*                                                                      *
 374 --             The Ghc Monad
 375 -- %*                                                                      *
 376 -- %************************************************************************
 377
 378 -- | Run function for the 'Ghc' monad.
 379 --
 380 -- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call
 381 -- to this function will create a new session which should not be shared among
 382 -- several threads.
 383 --
 384 -- Any errors not handled inside the 'Ghc' action are propagated as IO
 385 -- exceptions.
 386
 387 runGhc :: Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
 388        -> Ghc a           -- ^ The action to perform.
 389        -> IO a
 390 runGhc mb_top_dir ghc = do
 391   ref <- newIORef undefined
 392   let session = Session ref
 393   flip unGhc session $ do
 394     initGhcMonad mb_top_dir
 395     ghc
 396   -- XXX: unregister interrupt handlers here?
 397
 398 -- | Run function for 'GhcT' monad transformer.
 399 --
 400 -- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call
 401 -- to this function will create a new session which should not be shared among
 402 -- several threads.
 403
 404 runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
 405            Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
 406         -> GhcT m a        -- ^ The action to perform.
 407         -> m a
 408 runGhcT mb_top_dir ghct = do
 409   ref <- liftIO $ newIORef undefined
 410   let session = Session ref
 411   flip unGhcT session $ do
 412     initGhcMonad mb_top_dir
 413     ghct
 414
 415 -- | Initialise a GHC session.
 416 --
 417 -- If you implement a custom 'GhcMonad' you must call this function in the
 418 -- monad run function.  It will initialise the session variable and clear all
 419 -- warnings.
 420 --
 421 -- The first argument should point to the directory where GHC's library files
 422 -- reside.  More precisely, this should be the output of @ghc --print-libdir@
 423 -- of the version of GHC the module using this API is compiled with.  For
 424 -- portability, you should use the @ghc-paths@ package, available at
 425 -- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
 426
 427 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
 428 initGhcMonad mb_top_dir = do
 429   -- catch ^C
 430   liftIO $ installSignalHandlers
 431
 432   liftIO $ StaticFlags.initStaticOpts
 433
 434   dflags0 <- liftIO $ initDynFlags defaultDynFlags
 435   mySettings <- liftIO $ initSysTools mb_top_dir
 436   let dflags = dflags0 { settings = mySettings }
 437   env <- liftIO $ newHscEnv dflags
 438   setSession env
 439
 440
 441 -- %************************************************************************
 442 -- %*                                                                      *
 443 --             Flags & settings
 444 -- %*                                                                      *
 445 -- %************************************************************************
 446
 447 -- | Updates the DynFlags in a Session.  This also reads
 448 -- the package database (unless it has already been read),
 449 -- and prepares the compilers knowledge about packages.  It
 450 -- can be called again to load new packages: just add new
 451 -- package flags to (packageFlags dflags).
 452 --
 453 -- Returns a list of new packages that may need to be linked in using
 454 -- the dynamic linker (see 'linkPackages') as a result of new package
 455 -- flags.  If you are not doing linking or doing static linking, you
 456 -- can ignore the list of packages returned.
 457 --
 458 setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
 459 setSessionDynFlags dflags = do
 460   (dflags', preload) <- liftIO $ initPackages dflags
 461   modifySession (\h -> h{ hsc_dflags = dflags' })
 462   return preload
 463
 464
 465
 466 -- %************************************************************************
 467 -- %*                                                                      *
 468 --             Setting, getting, and modifying the targets
 469 -- %*                                                                      *
 470 -- %************************************************************************
 471
 472 -- ToDo: think about relative vs. absolute file paths. And what
 473 -- happens when the current directory changes.
 474
 475 -- | Sets the targets for this session.  Each target may be a module name
 476 -- or a filename.  The targets correspond to the set of root modules for
 477 -- the program\/library.  Unloading the current program is achieved by
 478 -- setting the current set of targets to be empty, followed by 'load'.
 479 setTargets :: GhcMonad m => [Target] -> m ()
 480 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
 481
 482 -- | Returns the current set of targets
 483 getTargets :: GhcMonad m => m [Target]
 484 getTargets = withSession (return . hsc_targets)
 485
 486 -- | Add another target.
 487 addTarget :: GhcMonad m => Target -> m ()
 488 addTarget target
 489   = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
 490
 491 -- | Remove a target
 492 removeTarget :: GhcMonad m => TargetId -> m ()
 493 removeTarget target_id
 494   = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
 495   where
 496    filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
 497
 498 -- | Attempts to guess what Target a string refers to.  This function
 499 -- implements the @--make@/GHCi command-line syntax for filenames:
 500 --
 501 --   - if the string looks like a Haskell source filename, then interpret it
 502 --     as such
 503 --
 504 --   - if adding a .hs or .lhs suffix yields the name of an existing file,
 505 --     then use that
 506 --
 507 --   - otherwise interpret the string as a module name
 508 --
 509 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
 510 guessTarget str (Just phase)
 511    = return (Target (TargetFile str (Just phase)) True Nothing)
 512 guessTarget str Nothing
 513    | isHaskellSrcFilename file
 514    = return (target (TargetFile file Nothing))
 515    | otherwise
 516    = do exists <- liftIO $ doesFileExist hs_file
 517         if exists
 518            then return (target (TargetFile hs_file Nothing))
 519            else do
 520         exists <- liftIO $ doesFileExist lhs_file
 521         if exists
 522            then return (target (TargetFile lhs_file Nothing))
 523            else do
 524         if looksLikeModuleName file
 525            then return (target (TargetModule (mkModuleName file)))
 526            else do
 527         throwGhcException
 528                  (ProgramError (showSDoc $
 529                  text "target" <+> quotes (text file) <+>
 530                  text "is not a module name or a source file"))
 531      where
 532          (file,obj_allowed)
 533                 | '*':rest <- str = (rest, False)
 534                 | otherwise       = (str,  True)
 535
 536          hs_file  = file <.> "hs"
 537          lhs_file = file <.> "lhs"
 538
 539          target tid = Target tid obj_allowed Nothing
 540
 541
 542 -- | Inform GHC that the working directory has changed.  GHC will flush
 543 -- its cache of module locations, since it may no longer be valid.
 544 --
 545 -- Note: Before changing the working directory make sure all threads running
 546 -- in the same session have stopped.  If you change the working directory,
 547 -- you should also unload the current program (set targets to empty,
 548 -- followed by load).
 549 workingDirectoryChanged :: GhcMonad m => m ()
 550 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
 551
 552
 553 -- %************************************************************************
 554 -- %*                                                                      *
 555 --             Running phases one at a time
 556 -- %*                                                                      *
 557 -- %************************************************************************
 558
 559 class ParsedMod m where
 560   modSummary   :: m -> ModSummary
 561   parsedSource :: m -> ParsedSource
 562
 563 class ParsedMod m => TypecheckedMod m where
 564   renamedSource     :: m -> Maybe RenamedSource
 565   typecheckedSource :: m -> TypecheckedSource
 566   moduleInfo        :: m -> ModuleInfo
 567   tm_internals      :: m -> (TcGblEnv, ModDetails)
 568         -- ToDo: improvements that could be made here:
 569         --  if the module succeeded renaming but not typechecking,
 570         --  we can still get back the GlobalRdrEnv and exports, so
 571         --  perhaps the ModuleInfo should be split up into separate
 572         --  fields.
 573
 574 class TypecheckedMod m => DesugaredMod m where
 575   coreModule :: m -> ModGuts
 576
 577 -- | The result of successful parsing.
 578 data ParsedModule =
 579   ParsedModule { pm_mod_summary   :: ModSummary
 580                , pm_parsed_source :: ParsedSource }
 581
 582 instance ParsedMod ParsedModule where
 583   modSummary m    = pm_mod_summary m
 584   parsedSource m = pm_parsed_source m
 585
 586 -- | The result of successful typechecking.  It also contains the parser
 587 --   result.
 588 data TypecheckedModule =
 589   TypecheckedModule { tm_parsed_module       :: ParsedModule
 590                     , tm_renamed_source      :: Maybe RenamedSource
 591                     , tm_typechecked_source  :: TypecheckedSource
 592                     , tm_checked_module_info :: ModuleInfo
 593                     , tm_internals_          :: (TcGblEnv, ModDetails)
 594                     }
 595
 596 instance ParsedMod TypecheckedModule where
 597   modSummary m   = modSummary (tm_parsed_module m)
 598   parsedSource m = parsedSource (tm_parsed_module m)
 599
 600 instance TypecheckedMod TypecheckedModule where
 601   renamedSource m     = tm_renamed_source m
 602   typecheckedSource m = tm_typechecked_source m
 603   moduleInfo m = tm_checked_module_info m
 604   tm_internals m      = tm_internals_ m
 605
 606 -- | The result of successful desugaring (i.e., translation to core).  Also
 607 --  contains all the information of a typechecked module.
 608 data DesugaredModule =
 609   DesugaredModule { dm_typechecked_module :: TypecheckedModule
 610                   , dm_core_module        :: ModGuts
 611              }
 612
 613 instance ParsedMod DesugaredModule where
 614   modSummary m   = modSummary (dm_typechecked_module m)
 615   parsedSource m = parsedSource (dm_typechecked_module m)
 616
 617 instance TypecheckedMod DesugaredModule where
 618   renamedSource m     = renamedSource (dm_typechecked_module m)
 619   typecheckedSource m = typecheckedSource (dm_typechecked_module m)
 620   moduleInfo m        = moduleInfo (dm_typechecked_module m)
 621   tm_internals m      = tm_internals_ (dm_typechecked_module m)
 622
 623 instance DesugaredMod DesugaredModule where
 624   coreModule m = dm_core_module m
 625
 626 type ParsedSource      = Located (HsModule RdrName)
 627 type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
 628                           Maybe LHsDocString)
 629 type TypecheckedSource = LHsBinds Id
 630
 631 -- NOTE:
 632 --   - things that aren't in the output of the typechecker right now:
 633 --     - the export list
 634 --     - the imports
 635 --     - type signatures
 636 --     - type/data/newtype declarations
 637 --     - class declarations
 638 --     - instances
 639 --   - extra things in the typechecker's output:
 640 --     - default methods are turned into top-level decls.
 641 --     - dictionary bindings
 642
 643 -- | Return the 'ModSummary' of a module with the given name.
 644 --
 645 -- The module must be part of the module graph (see 'hsc_mod_graph' and
 646 -- 'ModuleGraph').  If this is not the case, this function will throw a
 647 -- 'GhcApiError'.
 648 --
 649 -- This function ignores boot modules and requires that there is only one
 650 -- non-boot module with the given name.
 651 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
 652 getModSummary mod = do
 653    mg <- liftM hsc_mod_graph getSession
 654    case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
 655      [] -> throw $ mkApiErr (text "Module not part of module graph")
 656      [ms] -> return ms
 657      multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
 658
 659 -- | Parse a module.
 660 --
 661 -- Throws a 'SourceError' on parse error.
 662 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
 663 parseModule ms = do
 664    hsc_env <- getSession
 665    let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 666    rdr_module <- liftIO $ hscParse hsc_env_tmp ms
 667    return (ParsedModule ms rdr_module)
 668
 669 -- | Typecheck and rename a parsed module.
 670 --
 671 -- Throws a 'SourceError' if either fails.
 672 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
 673 typecheckModule pmod = do
 674  let ms = modSummary pmod
 675  hsc_env <- getSession
 676  let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 677  (tc_gbl_env, rn_info)
 678        <- liftIO $ hscTypecheckRename hsc_env_tmp ms (parsedSource pmod)
 679  details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
 680  return $
 681      TypecheckedModule {
 682        tm_internals_          = (tc_gbl_env, details),
 683        tm_parsed_module       = pmod,
 684        tm_renamed_source      = rn_info,
 685        tm_typechecked_source  = tcg_binds tc_gbl_env,
 686        tm_checked_module_info =
 687          ModuleInfo {
 688            minf_type_env  = md_types details,
 689            minf_exports   = availsToNameSet $ md_exports details,
 690            minf_rdr_env   = Just (tcg_rdr_env tc_gbl_env),
 691            minf_instances = md_insts details
 692 #ifdef GHCI
 693            ,minf_modBreaks = emptyModBreaks
 694 #endif
 695          }}
 696
 697 -- | Desugar a typechecked module.
 698 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
 699 desugarModule tcm = do
 700  let ms = modSummary tcm
 701  let (tcg, _) = tm_internals tcm
 702  hsc_env <- getSession
 703  let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
 704  guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg
 705  return $
 706      DesugaredModule {
 707        dm_typechecked_module = tcm,
 708        dm_core_module        = guts
 709      }
 710
 711 -- | Load a module.  Input doesn't need to be desugared.
 712 --
 713 -- A module must be loaded before dependent modules can be typechecked.  This
 714 -- always includes generating a 'ModIface' and, depending on the
 715 -- 'DynFlags.hscTarget', may also include code generation.
 716 --
 717 -- This function will always cause recompilation and will always overwrite
 718 -- previous compilation results (potentially files on disk).
 719 --
 720 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
 721 loadModule tcm = do
 722    let ms = modSummary tcm
 723    let mod = ms_mod_name ms
 724    let loc = ms_location ms
 725    let (tcg, _details) = tm_internals tcm
 726
 727    mb_linkable <- case ms_obj_date ms of
 728                      Just t | t > ms_hs_date ms  -> do
 729                          l <- liftIO $ findObjectLinkable (ms_mod ms)
 730                                                   (ml_obj_file loc) t
 731                          return (Just l)
 732                      _otherwise -> return Nothing
 733
 734    -- compile doesn't change the session
 735    hsc_env <- getSession
 736    mod_info <- liftIO $ compile' (hscNothingBackendOnly     tcg,
 737                                   hscInteractiveBackendOnly tcg,
 738                                   hscBatchBackendOnly       tcg)
 739                                   hsc_env ms 1 1 Nothing mb_linkable
 740
 741    modifySession $ \e -> e{ hsc_HPT = addToUFM (hsc_HPT e) mod mod_info }
 742    return tcm
 743
 744
 745 -- %************************************************************************
 746 -- %*                                                                      *
 747 --             Dealing with Core
 748 -- %*                                                                      *
 749 -- %************************************************************************
 750
 751 -- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
 752 -- the 'GHC.compileToCoreModule' interface.
 753 data CoreModule
 754   = CoreModule {
 755       -- | Module name
 756       cm_module   :: !Module,
 757       -- | Type environment for types declared in this module
 758       cm_types    :: !TypeEnv,
 759       -- | Declarations
 760       cm_binds    :: [CoreBind]
 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_binds = cg_binds cg
 860         }
 861         gutsToCoreModule (Right mg) = CoreModule {
 862           cm_module  = mg_module mg,                   cm_types   = mg_types mg,
 863           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)