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