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