ghc/compiler/main/HscMain.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
   3 %
   4
   5 \section[GHC_Main]{Main driver for Glasgow Haskell compiler}
   6
   7 \begin{code}
   8 module HscMain (
   9         HscResult(..), hscMain, newHscEnv, hscCmmFile, hscBufferFrontEnd
  10 #ifdef GHCI
  11         , hscStmt, hscTcExpr, hscKcType, hscThing,
  12         , compileExpr
  13 #endif
  14         ) where
  15
  16 #include "HsVersions.h"
  17
  18 #ifdef GHCI
  19 import HsSyn            ( Stmt(..), LStmt, LHsExpr, LHsType )
  20 import IfaceSyn         ( IfaceDecl )
  21 import CodeOutput       ( outputForeignStubs )
  22 import ByteCodeGen      ( byteCodeGen, coreExprToBCOs )
  23 import Linker           ( HValue, linkExpr )
  24 import TidyPgm          ( tidyCoreExpr )
  25 import CorePrep         ( corePrepExpr )
  26 import Flattening       ( flattenExpr )
  27 import TcRnDriver       ( tcRnStmt, tcRnExpr, tcRnThing, tcRnType )
  28 import RdrName          ( RdrName )
  29 import Type             ( Type )
  30 import PrelNames        ( iNTERACTIVE )
  31 import StringBuffer     ( stringToStringBuffer )
  32 import SrcLoc           ( SrcLoc, noSrcLoc, Located(..) )
  33 import Kind             ( Kind )
  34 import Var              ( Id )
  35 import CoreLint         ( lintUnfolding )
  36 import DsMeta           ( templateHaskellNames )
  37 import BasicTypes       ( Fixity )
  38 #endif
  39
  40 import StringBuffer     ( hGetStringBuffer )
  41 import Parser
  42 import Lexer            ( P(..), ParseResult(..), mkPState )
  43 import SrcLoc           ( mkSrcLoc )
  44 import TcRnDriver       ( tcRnModule, tcRnExtCore )
  45 import TcIface          ( typecheckIface )
  46 import IfaceEnv         ( initNameCache )
  47 import LoadIface        ( ifaceStats, initExternalPackageState )
  48 import PrelInfo         ( wiredInThings, basicKnownKeyNames )
  49 import RdrName          ( GlobalRdrEnv )
  50 import MkIface          ( checkOldIface, mkIface )
  51 import Desugar
  52 import Flattening       ( flatten )
  53 import SimplCore
  54 import TidyPgm          ( tidyCorePgm )
  55 import CorePrep         ( corePrepPgm )
  56 import CoreToStg        ( coreToStg )
  57 import Name             ( Name, NamedThing(..) )
  58 import SimplStg         ( stg2stg )
  59 import CodeGen          ( codeGen )
  60 import CmmParse         ( parseCmmFile )
  61 import CodeOutput       ( codeOutput )
  62
  63 import CmdLineOpts
  64 import DriverPhases     ( isExtCoreFilename )
  65 import ErrUtils
  66 import UniqSupply       ( mkSplitUniqSupply )
  67
  68 import Outputable
  69 import HscStats         ( ppSourceStats )
  70 import HscTypes
  71 import MkExternalCore   ( emitExternalCore )
  72 import ParserCore
  73 import ParserCoreUtils
  74 import Module           ( Module, ModLocation(..), showModMsg )
  75 import FastString
  76 import Maybes           ( expectJust )
  77 import StringBuffer     ( StringBuffer )
  78 import Bag              ( unitBag, emptyBag )
  79
  80 import Monad            ( when )
  81 import Maybe            ( isJust, fromJust )
  82 import IO
  83 import DATA_IOREF       ( newIORef, readIORef )
  84 \end{code}
  85
  86
  87 %************************************************************************
  88 %*                                                                      *
  89                 Initialisation
  90 %*                                                                      *
  91 %************************************************************************
  92
  93 \begin{code}
  94 newHscEnv :: GhciMode -> DynFlags -> IO HscEnv
  95 newHscEnv ghci_mode dflags
  96   = do  { eps_var <- newIORef initExternalPackageState
  97         ; us      <- mkSplitUniqSupply 'r'
  98         ; nc_var  <- newIORef (initNameCache us knownKeyNames)
  99         ; return (HscEnv { hsc_mode   = ghci_mode,
 100                            hsc_dflags = dflags,
 101                            hsc_HPT    = emptyHomePackageTable,
 102                            hsc_EPS    = eps_var,
 103                            hsc_NC     = nc_var } ) }
 104
 105
 106 knownKeyNames :: [Name] -- Put here to avoid loops involving DsMeta,
 107                         -- where templateHaskellNames are defined
 108 knownKeyNames = map getName wiredInThings
 109               ++ basicKnownKeyNames
 110 #ifdef GHCI
 111               ++ templateHaskellNames
 112 #endif
 113 \end{code}
 114
 115
 116 %************************************************************************
 117 %*                                                                      *
 118                 The main compiler pipeline
 119 %*                                                                      *
 120 %************************************************************************
 121
 122 \begin{code}
 123 data HscResult
 124    -- Compilation failed
 125    = HscFail
 126
 127    -- In IDE mode: we just do the static/dynamic checks
 128    | HscChecked
 129
 130    -- Concluded that it wasn't necessary
 131    | HscNoRecomp ModDetails              -- new details (HomeSymbolTable additions)
 132                  ModIface                -- new iface (if any compilation was done)
 133
 134    -- Did recompilation
 135    | HscRecomp   ModDetails             -- new details (HomeSymbolTable additions)
 136                  (Maybe GlobalRdrEnv)
 137                  ModIface               -- new iface (if any compilation was done)
 138                  Bool                   -- stub_h exists
 139                  Bool                   -- stub_c exists
 140                  (Maybe CompiledByteCode)
 141
 142
 143 -- What to do when we have compiler error or warning messages
 144 type MessageAction = Messages -> IO ()
 145
 146         -- no errors or warnings; the individual passes
 147         -- (parse/rename/typecheck) print messages themselves
 148
 149 hscMain
 150   :: HscEnv
 151   -> MessageAction              -- what to do with errors/warnings
 152   -> Module
 153   -> ModLocation                -- location info
 154   -> Bool                       -- True <=> source unchanged
 155   -> Bool                       -- True <=> have an object file (for msgs only)
 156   -> Maybe ModIface             -- old interface, if available
 157   -> IO HscResult
 158
 159 hscMain hsc_env msg_act mod location
 160         source_unchanged have_object maybe_old_iface
 161  = do {
 162       (recomp_reqd, maybe_checked_iface) <-
 163                 _scc_ "checkOldIface"
 164                 checkOldIface hsc_env mod
 165                               (ml_hi_file location)
 166                               source_unchanged maybe_old_iface;
 167
 168       let no_old_iface = not (isJust maybe_checked_iface)
 169           what_next | recomp_reqd || no_old_iface = hscRecomp
 170                     | otherwise                   = hscNoRecomp
 171
 172       ; what_next hsc_env msg_act have_object
 173                   mod location maybe_checked_iface
 174       }
 175
 176
 177 -- hscNoRecomp definitely expects to have the old interface available
 178 hscNoRecomp hsc_env msg_act have_object
 179             mod location (Just old_iface)
 180  | hsc_mode hsc_env == OneShot
 181  = do {
 182       when (verbosity (hsc_dflags hsc_env) > 0) $
 183           hPutStrLn stderr "compilation IS NOT required";
 184       dumpIfaceStats hsc_env ;
 185
 186       let { bomb = panic "hscNoRecomp:OneShot" };
 187       return (HscNoRecomp bomb bomb)
 188       }
 189  | otherwise
 190  = do {
 191       when (verbosity (hsc_dflags hsc_env) >= 1) $
 192                 hPutStrLn stderr ("Skipping  " ++
 193                         showModMsg have_object mod location);
 194
 195       new_details <- _scc_ "tcRnIface"
 196                      typecheckIface hsc_env old_iface ;
 197       dumpIfaceStats hsc_env ;
 198
 199       return (HscNoRecomp new_details old_iface)
 200       }
 201
 202 hscRecomp hsc_env msg_act have_object
 203           mod location maybe_checked_iface
 204  = do   {
 205           -- what target are we shooting for?
 206         ; let one_shot  = hsc_mode hsc_env == OneShot
 207         ; let dflags    = hsc_dflags hsc_env
 208         ; let toInterp  = dopt_HscLang dflags == HscInterpreted
 209         ; let toCore    = isJust (ml_hs_file location) &&
 210                           isExtCoreFilename (fromJust (ml_hs_file location))
 211
 212         ; when (not one_shot && verbosity dflags >= 1) $
 213                 hPutStrLn stderr ("Compiling " ++
 214                         showModMsg (not toInterp) mod location);
 215
 216         ; front_res <- if toCore then
 217                           hscCoreFrontEnd hsc_env msg_act location
 218                        else
 219                           hscFileFrontEnd hsc_env msg_act location
 220
 221         ; case front_res of
 222             Left flure -> return flure;
 223             Right ds_result -> do {
 224
 225
 226         -- OMITTED:
 227         -- ; seqList imported_modules (return ())
 228
 229             -------------------
 230             -- FLATTENING
 231             -------------------
 232         ; flat_result <- _scc_ "Flattening"
 233                          flatten hsc_env ds_result
 234
 235
 236 {-      TEMP: need to review space-leak fixing here
 237         NB: even the code generator can force one of the
 238             thunks for constructor arguments, for newtypes in particular
 239
 240         ; let   -- Rule-base accumulated from imported packages
 241              pkg_rule_base = eps_rule_base (hsc_EPS hsc_env)
 242
 243                 -- In one-shot mode, ZAP the external package state at
 244                 -- this point, because we aren't going to need it from
 245                 -- now on.  We keep the name cache, however, because
 246                 -- tidyCore needs it.
 247              pcs_middle
 248                  | one_shot  = pcs_tc{ pcs_EPS = error "pcs_EPS missing" }
 249                  | otherwise = pcs_tc
 250
 251         ; pkg_rule_base `seq` pcs_middle `seq` return ()
 252 -}
 253
 254         -- alive at this point:
 255         --      pcs_middle
 256         --      flat_result
 257         --      pkg_rule_base
 258
 259             -------------------
 260             -- SIMPLIFY
 261             -------------------
 262         ; simpl_result <- _scc_ "Core2Core"
 263                           core2core hsc_env flat_result
 264
 265             -------------------
 266             -- TIDY
 267             -------------------
 268         ; tidy_result <- _scc_ "CoreTidy"
 269                          tidyCorePgm hsc_env simpl_result
 270
 271         -- Emit external core
 272         ; emitExternalCore dflags tidy_result
 273
 274         -- Alive at this point:
 275         --      tidy_result, pcs_final
 276         --      hsc_env
 277
 278             -------------------
 279             -- BUILD THE NEW ModIface and ModDetails
 280             --  and emit external core if necessary
 281             -- This has to happen *after* code gen so that the back-end
 282             -- info has been set.  Not yet clear if it matters waiting
 283             -- until after code output
 284         ; new_iface <- _scc_ "MkFinalIface"
 285                         mkIface hsc_env location
 286                                 maybe_checked_iface tidy_result
 287
 288
 289             -- Space leak reduction: throw away the new interface if
 290             -- we're in one-shot mode; we won't be needing it any
 291             -- more.
 292         ; final_iface <-
 293              if one_shot then return (error "no final iface")
 294                          else return new_iface
 295         ; let { final_globals | one_shot  = Nothing
 296                               | otherwise = Just $! (mg_rdr_env tidy_result) }
 297         ; final_globals `seq` return ()
 298
 299             -- Build the final ModDetails (except in one-shot mode, where
 300             -- we won't need this information after compilation).
 301         ; final_details <-
 302              if one_shot then return (error "no final details")
 303                          else return $! ModDetails {
 304                                            md_types = mg_types tidy_result,
 305                                            md_insts = mg_insts tidy_result,
 306                                            md_rules = mg_rules tidy_result }
 307
 308             -------------------
 309             -- CONVERT TO STG and COMPLETE CODE GENERATION
 310         ; (stub_h_exists, stub_c_exists, maybe_bcos)
 311                 <- hscBackEnd dflags tidy_result
 312
 313           -- And the answer is ...
 314         ; dumpIfaceStats hsc_env
 315
 316         ; return (HscRecomp final_details
 317                             final_globals
 318                             final_iface
 319                             stub_h_exists stub_c_exists
 320                             maybe_bcos)
 321          }}
 322
 323 hscCoreFrontEnd hsc_env msg_act location = do {
 324             -------------------
 325             -- PARSE
 326             -------------------
 327         ; inp <- readFile (expectJust "hscCoreFrontEnd:hspp" (ml_hspp_file location))
 328         ; case parseCore inp 1 of
 329             FailP s        -> hPutStrLn stderr s >> return (Left HscFail)
 330             OkP rdr_module -> do {
 331
 332             -------------------
 333             -- RENAME and TYPECHECK
 334             -------------------
 335         ; (tc_msgs, maybe_tc_result) <- _scc_ "TypeCheck"
 336                               tcRnExtCore hsc_env rdr_module
 337         ; msg_act tc_msgs
 338         ; case maybe_tc_result of {
 339              Nothing       -> return (Left  HscFail);
 340              Just mod_guts -> return (Right mod_guts)
 341                                         -- No desugaring to do!
 342         }}}
 343
 344
 345 hscFileFrontEnd hsc_env msg_act location = do {
 346             -------------------
 347             -- PARSE
 348             -------------------
 349         ; maybe_parsed <- myParseModule (hsc_dflags hsc_env)
 350                              (expectJust "hscFrontEnd:hspp" (ml_hspp_file location))
 351
 352         ; case maybe_parsed of {
 353              Left err -> do { msg_act (unitBag err, emptyBag) ;
 354                             ; return (Left HscFail) ;
 355                             };
 356              Right rdr_module -> hscFrontEnd hsc_env msg_act rdr_module
 357     }}
 358
 359 -- Perform static/dynamic checks on the source code in a StringBuffer
 360 -- This is a temporary solution: it'll read in interface files lazily, whereas
 361 -- we probably want to use the compilation manager to load in all the modules
 362 -- in a project.
 363 hscBufferFrontEnd :: HscEnv -> StringBuffer -> MessageAction -> IO HscResult
 364 hscBufferFrontEnd hsc_env buffer msg_act = do
 365         let loc  = mkSrcLoc (mkFastString "*edit*") 1 0
 366         case unP parseModule (mkPState buffer loc (hsc_dflags hsc_env)) of
 367                 PFailed span err -> do
 368                         msg_act (emptyBag, unitBag (mkPlainErrMsg span err))
 369                         return HscFail
 370                 POk _ rdr_module -> do
 371                         r <- hscFrontEnd hsc_env msg_act rdr_module
 372                         case r of
 373                            Left r -> return r
 374                            Right _ -> return HscChecked
 375
 376
 377
 378 hscFrontEnd hsc_env msg_act rdr_module  = do {
 379             -------------------
 380             -- RENAME and TYPECHECK
 381             -------------------
 382         ; (tc_msgs, maybe_tc_result) <- _scc_ "Typecheck-Rename"
 383                                         tcRnModule hsc_env rdr_module
 384         ; msg_act tc_msgs
 385         ; case maybe_tc_result of {
 386              Nothing -> return (Left HscFail);
 387              Just tc_result -> do {
 388
 389             -------------------
 390             -- DESUGAR
 391             -------------------
 392         ; (warns, maybe_ds_result) <- _scc_ "DeSugar"
 393                              deSugar hsc_env tc_result
 394         ; msg_act (warns, emptyBag)
 395         ; case maybe_ds_result of
 396             Nothing        -> return (Left HscFail);
 397             Just ds_result -> return (Right ds_result);
 398         }}}
 399
 400 hscBackEnd dflags
 401     ModGuts{  -- This is the last use of the ModGuts in a compilation.
 402               -- From now on, we just use the bits we need.
 403         mg_module   = this_mod,
 404         mg_binds    = core_binds,
 405         mg_types    = type_env,
 406         mg_dir_imps = dir_imps,
 407         mg_foreign  = foreign_stubs,
 408         mg_deps     = dependencies     }  = do {
 409
 410             -------------------
 411             -- PREPARE FOR CODE GENERATION
 412             -- Do saturation and convert to A-normal form
 413   prepd_binds <- _scc_ "CorePrep"
 414                  corePrepPgm dflags core_binds type_env;
 415
 416   case dopt_HscLang dflags of
 417       HscNothing -> return (False, False, Nothing)
 418
 419       HscInterpreted ->
 420 #ifdef GHCI
 421         do  -----------------  Generate byte code ------------------
 422             comp_bc <- byteCodeGen dflags prepd_binds type_env
 423
 424             ------------------ Create f-x-dynamic C-side stuff ---
 425             (istub_h_exists, istub_c_exists)
 426                <- outputForeignStubs dflags foreign_stubs
 427
 428             return ( istub_h_exists, istub_c_exists, Just comp_bc )
 429 #else
 430         panic "GHC not compiled with interpreter"
 431 #endif
 432
 433       other ->
 434         do
 435             -----------------  Convert to STG ------------------
 436             (stg_binds, cost_centre_info) <- _scc_ "CoreToStg"
 437                          myCoreToStg dflags this_mod prepd_binds
 438
 439             ------------------  Code generation ------------------
 440             abstractC <- _scc_ "CodeGen"
 441                          codeGen dflags this_mod type_env foreign_stubs
 442                                  dir_imps cost_centre_info stg_binds
 443
 444             ------------------  Code output -----------------------
 445             (stub_h_exists, stub_c_exists)
 446                      <- codeOutput dflags this_mod foreign_stubs
 447                                 dependencies abstractC
 448
 449             return (stub_h_exists, stub_c_exists, Nothing)
 450    }
 451
 452
 453 hscCmmFile :: DynFlags -> FilePath -> IO Bool
 454 hscCmmFile dflags filename = do
 455   maybe_cmm <- parseCmmFile dflags filename
 456   case maybe_cmm of
 457     Nothing -> return False
 458     Just cmm -> do
 459         codeOutput dflags no_mod NoStubs noDependencies [cmm]
 460         return True
 461   where
 462         no_mod = panic "hscCmmFile: no_mod"
 463
 464
 465 myParseModule dflags src_filename
 466  = do --------------------------  Parser  ----------------
 467       showPass dflags "Parser"
 468       _scc_  "Parser" do
 469       buf <- hGetStringBuffer src_filename
 470
 471       let loc  = mkSrcLoc (mkFastString src_filename) 1 0
 472
 473       case unP parseModule (mkPState buf loc dflags) of {
 474
 475         PFailed span err -> return (Left (mkPlainErrMsg span err));
 476
 477         POk _ rdr_module -> do {
 478
 479       dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_module) ;
 480
 481       dumpIfSet_dyn dflags Opt_D_source_stats "Source Statistics"
 482                            (ppSourceStats False rdr_module) ;
 483
 484       return (Right rdr_module)
 485         -- ToDo: free the string buffer later.
 486       }}
 487
 488
 489 myCoreToStg dflags this_mod prepd_binds
 490  = do
 491       stg_binds <- _scc_ "Core2Stg"
 492              coreToStg dflags prepd_binds
 493
 494       (stg_binds2, cost_centre_info) <- _scc_ "Core2Stg"
 495              stg2stg dflags this_mod stg_binds
 496
 497       return (stg_binds2, cost_centre_info)
 498 \end{code}
 499
 500
 501 %************************************************************************
 502 %*                                                                      *
 503 \subsection{Compiling a do-statement}
 504 %*                                                                      *
 505 %************************************************************************
 506
 507 When the UnlinkedBCOExpr is linked you get an HValue of type
 508         IO [HValue]
 509 When you run it you get a list of HValues that should be
 510 the same length as the list of names; add them to the ClosureEnv.
 511
 512 A naked expression returns a singleton Name [it].
 513
 514         What you type                   The IO [HValue] that hscStmt returns
 515         -------------                   ------------------------------------
 516         let pat = expr          ==>     let pat = expr in return [coerce HVal x, coerce HVal y, ...]
 517                                         bindings: [x,y,...]
 518
 519         pat <- expr             ==>     expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
 520                                         bindings: [x,y,...]
 521
 522         expr (of IO type)       ==>     expr >>= \ v -> return [v]
 523           [NB: result not printed]      bindings: [it]
 524
 525
 526         expr (of non-IO type,
 527           result showable)      ==>     let v = expr in print v >> return [v]
 528                                         bindings: [it]
 529
 530         expr (of non-IO type,
 531           result not showable)  ==>     error
 532
 533 \begin{code}
 534 #ifdef GHCI
 535 hscStmt         -- Compile a stmt all the way to an HValue, but don't run it
 536   :: HscEnv
 537   -> InteractiveContext         -- Context for compiling
 538   -> String                     -- The statement
 539   -> IO (Maybe (InteractiveContext, [Name], HValue))
 540
 541 hscStmt hsc_env icontext stmt
 542   = do  { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) stmt
 543         ; case maybe_stmt of {
 544              Nothing      -> return Nothing ;   -- Parse error
 545              Just Nothing -> return Nothing ;   -- Empty line
 546              Just (Just parsed_stmt) -> do {    -- The real stuff
 547
 548                 -- Rename and typecheck it
 549           maybe_tc_result
 550                  <- tcRnStmt hsc_env icontext parsed_stmt
 551
 552         ; case maybe_tc_result of {
 553                 Nothing -> return Nothing ;
 554                 Just (new_ic, bound_names, tc_expr) -> do {
 555
 556                 -- Then desugar, code gen, and link it
 557         ; hval <- compileExpr hsc_env iNTERACTIVE
 558                               (ic_rn_gbl_env new_ic)
 559                               (ic_type_env new_ic)
 560                               tc_expr
 561
 562         ; return (Just (new_ic, bound_names, hval))
 563         }}}}}
 564
 565 hscTcExpr       -- Typecheck an expression (but don't run it)
 566   :: HscEnv
 567   -> InteractiveContext         -- Context for compiling
 568   -> String                     -- The expression
 569   -> IO (Maybe Type)
 570
 571 hscTcExpr hsc_env icontext expr
 572   = do  { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) expr
 573         ; case maybe_stmt of {
 574              Nothing      -> return Nothing ;   -- Parse error
 575              Just (Just (L _ (ExprStmt expr _)))
 576                         -> tcRnExpr hsc_env icontext expr ;
 577              Just other -> do { hPutStrLn stderr ("not an expression: `" ++ expr ++ "'") ;
 578                                 return Nothing } ;
 579              } }
 580
 581 hscKcType       -- Find the kind of a type
 582   :: HscEnv
 583   -> InteractiveContext         -- Context for compiling
 584   -> String                     -- The type
 585   -> IO (Maybe Kind)
 586
 587 hscKcType hsc_env icontext str
 588   = do  { maybe_type <- hscParseType (hsc_dflags hsc_env) str
 589         ; case maybe_type of {
 590              Just ty    -> tcRnType hsc_env icontext ty ;
 591              Just other -> do { hPutStrLn stderr ("not an type: `" ++ str ++ "'") ;
 592                                 return Nothing } ;
 593              Nothing    -> return Nothing } }
 594 \end{code}
 595
 596 \begin{code}
 597 hscParseStmt :: DynFlags -> String -> IO (Maybe (Maybe (LStmt RdrName)))
 598 hscParseStmt = hscParseThing parseStmt
 599
 600 hscParseType :: DynFlags -> String -> IO (Maybe (LHsType RdrName))
 601 hscParseType = hscParseThing parseType
 602
 603 hscParseIdentifier :: DynFlags -> String -> IO (Maybe (Located RdrName))
 604 hscParseIdentifier = hscParseThing parseIdentifier
 605
 606 hscParseThing :: Outputable thing
 607               => Lexer.P thing
 608               -> DynFlags -> String
 609               -> IO (Maybe thing)
 610         -- Nothing => Parse error (message already printed)
 611         -- Just x  => success
 612 hscParseThing parser dflags str
 613  = do showPass dflags "Parser"
 614       _scc_ "Parser"  do
 615
 616       buf <- stringToStringBuffer str
 617
 618       let loc  = mkSrcLoc FSLIT("<interactive>") 1 0
 619
 620       case unP parser (mkPState buf loc dflags) of {
 621
 622         PFailed span err -> do { printError span err;
 623                                  return Nothing };
 624
 625         POk _ thing -> do {
 626
 627       --ToDo: can't free the string buffer until we've finished this
 628       -- compilation sweep and all the identifiers have gone away.
 629       dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr thing);
 630       return (Just thing)
 631       }}
 632 #endif
 633 \end{code}
 634
 635 %************************************************************************
 636 %*                                                                      *
 637 \subsection{Getting information about an identifer}
 638 %*                                                                      *
 639 %************************************************************************
 640
 641 \begin{code}
 642 #ifdef GHCI
 643 hscThing -- like hscStmt, but deals with a single identifier
 644   :: HscEnv
 645   -> InteractiveContext         -- Context for compiling
 646   -> String                     -- The identifier
 647   -> IO [(IfaceDecl, Fixity, SrcLoc)]
 648
 649 hscThing hsc_env ic str
 650    = do maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
 651         case maybe_rdr_name of {
 652           Nothing -> return [];
 653           Just (L _ rdr_name) -> do
 654
 655         maybe_tc_result <- tcRnThing hsc_env ic rdr_name
 656
 657         case maybe_tc_result of {
 658              Nothing     -> return [] ;
 659              Just things -> return things
 660         }}
 661 #endif
 662 \end{code}
 663
 664 %************************************************************************
 665 %*                                                                      *
 666         Desugar, simplify, convert to bytecode, and link an expression
 667 %*                                                                      *
 668 %************************************************************************
 669
 670 \begin{code}
 671 #ifdef GHCI
 672 compileExpr :: HscEnv
 673             -> Module -> GlobalRdrEnv -> TypeEnv
 674             -> LHsExpr Id
 675             -> IO HValue
 676
 677 compileExpr hsc_env this_mod rdr_env type_env tc_expr
 678   = do  { let { dflags  = hsc_dflags hsc_env ;
 679                 lint_on = dopt Opt_DoCoreLinting dflags }
 680
 681                 -- Desugar it
 682         ; ds_expr <- deSugarExpr hsc_env this_mod rdr_env type_env tc_expr
 683
 684                 -- Flatten it
 685         ; flat_expr <- flattenExpr hsc_env ds_expr
 686
 687                 -- Simplify it
 688         ; simpl_expr <- simplifyExpr dflags flat_expr
 689
 690                 -- Tidy it (temporary, until coreSat does cloning)
 691         ; tidy_expr <- tidyCoreExpr simpl_expr
 692
 693                 -- Prepare for codegen
 694         ; prepd_expr <- corePrepExpr dflags tidy_expr
 695
 696                 -- Lint if necessary
 697                 -- ToDo: improve SrcLoc
 698         ; if lint_on then
 699                 case lintUnfolding noSrcLoc [] prepd_expr of
 700                    Just err -> pprPanic "compileExpr" err
 701                    Nothing  -> return ()
 702           else
 703                 return ()
 704
 705                 -- Convert to BCOs
 706         ; bcos <- coreExprToBCOs dflags prepd_expr
 707
 708                 -- link it
 709         ; hval <- linkExpr hsc_env bcos
 710
 711         ; return hval
 712      }
 713 #endif
 714 \end{code}
 715
 716
 717 %************************************************************************
 718 %*                                                                      *
 719         Statistics on reading interfaces
 720 %*                                                                      *
 721 %************************************************************************
 722
 723 \begin{code}
 724 dumpIfaceStats :: HscEnv -> IO ()
 725 dumpIfaceStats hsc_env
 726   = do  { eps <- readIORef (hsc_EPS hsc_env)
 727         ; dumpIfSet (dump_if_trace || dump_rn_stats)
 728                     "Interface statistics"
 729                     (ifaceStats eps) }
 730   where
 731     dflags = hsc_dflags hsc_env
 732     dump_rn_stats = dopt Opt_D_dump_rn_stats dflags
 733     dump_if_trace = dopt Opt_D_dump_if_trace dflags
 734 \end{code}