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