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