HscMain.lhs 19.4 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
3
%
4

5
6
7
\section[GHC_Main]{Main driver for Glasgow Haskell compiler}

\begin{code}
8
9
module HscMain ( HscResult(..), hscMain, 
#ifdef GHCI
10
		 hscStmt,
11
#endif
12
		 initPersistentCompilerState ) where
13

14
#include "HsVersions.h"
15

16
#ifdef GHCI
17
import ByteCodeGen	( byteCodeGen )
18
19
20
21
22
import CoreTidy		( tidyCoreExpr )
import CorePrep		( corePrepExpr )
import Rename		( renameStmt )
import RdrHsSyn		( RdrNameStmt )
import Type		( Type )
23
import Id		( Id, idName, setGlobalIdDetails )
24
import IdInfo		( GlobalIdDetails(VanillaGlobal) )
25
import HscTypes		( InteractiveContext(..) )
26
import PrelNames	( iNTERACTIVE )
27
import StringBuffer	( stringToStringBuffer )
28
29
#endif

30
31
import HsSyn

32
33
34
import Id		( idName )
import IdInfo		( CafInfo(..), CgInfoEnv, CgInfo(..) )
import StringBuffer	( hGetStringBuffer, freeStringBuffer )
35
import Parser
36
import Lex		( PState(..), ParseResult(..) )
37
import SrcLoc		( mkSrcLoc )
38
import Finder		( findModule )
39
import Rename		( checkOldIface, renameModule, closeIfaceDecls )
40
import Rules		( emptyRuleBase )
41
import PrelInfo		( wiredInThingEnv, wiredInThings )
42
import PrelNames	( knownKeyNames )
43
import MkIface		( mkFinalIface )
44
import TcModule
45
import InstEnv		( emptyInstEnv )
46
47
import Desugar
import SimplCore
48
import CoreUtils	( coreBindsSize )
49
import CoreTidy		( tidyCorePgm )
50
51
import CorePrep		( corePrepPgm )
import StgSyn
52
import CoreToStg	( coreToStg )
53
54
import SimplStg		( stg2stg )
import CodeGen		( codeGen )
55
import CodeOutput	( codeOutput )
56

57
58
import Module		( ModuleName, moduleName, mkHomeModule, 
			  moduleUserString )
59
import CmdLineOpts
60
import ErrUtils		( dumpIfSet_dyn, showPass, printError )
61
import Util		( unJust )
62
import UniqSupply	( mkSplitUniqSupply )
63

64
import Bag		( emptyBag )
65
import Outputable
66
import Interpreter
67
import HscStats		( ppSourceStats )
68
import HscTypes
69
import FiniteMap	( FiniteMap, plusFM, emptyFM, addToFM )
70
import OccName		( OccName )
71
import Name		( Name, nameModule, nameOccName, getName, isGlobalName )
72
import NameEnv		( emptyNameEnv, mkNameEnv )
73
import Module		( Module )
74
75

import IOExts		( newIORef, readIORef, writeIORef, unsafePerformIO )
76

77
import Monad		( when )
78
import Maybe		( isJust, fromJust )
79
import IO
apt's avatar
apt committed
80
81

import MkExternalCore	( emitExternalCore )
82
83
\end{code}

84
85
86
87
88
89
90

%************************************************************************
%*									*
\subsection{The main compiler pipeline}
%*									*
%************************************************************************

91
\begin{code}
92
data HscResult
93
94
95
96
97
98
99
100
101
102
   -- compilation failed
   = HscFail     PersistentCompilerState -- updated PCS
   -- concluded that it wasn't necessary
   | HscNoRecomp PersistentCompilerState -- updated PCS
                 ModDetails  	         -- new details (HomeSymbolTable additions)
	         ModIface	         -- new iface (if any compilation was done)
   -- did recompilation
   | HscRecomp   PersistentCompilerState -- updated PCS
                 ModDetails  		 -- new details (HomeSymbolTable additions)
                 ModIface		 -- new iface (if any compilation was done)
103
104
	         Bool	 	 	-- stub_h exists
	         Bool  		 	-- stub_c exists
105
	         (Maybe ([UnlinkedBCO],ItblEnv)) -- interpreted code, if any
106
107
             

108
109
	-- no errors or warnings; the individual passes
	-- (parse/rename/typecheck) print messages themselves
110

111
hscMain
112
113
  :: GhciMode
  -> DynFlags
114
  -> Module
115
  -> ModuleLocation		-- location info
116
117
  -> Bool			-- True <=> source unchanged
  -> Bool			-- True <=> have an object file (for msgs only)
118
  -> Maybe ModIface		-- old interface, if available
119
  -> HomeSymbolTable		-- for home module ModDetails
120
  -> HomeIfaceTable
121
  -> PersistentCompilerState    -- IN: persistent compiler state
122
  -> IO HscResult
123

124
125
hscMain ghci_mode dflags mod location source_unchanged have_object 
	maybe_old_iface hst hit pcs
126
 = do {
127
128
129
      showPass dflags ("Checking old interface for hs = " 
			++ show (ml_hs_file location)
                	++ ", hspp = " ++ show (ml_hspp_file location));
130

131
      (pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
132
         <- _scc_ "checkOldIface"
133
	    checkOldIface ghci_mode dflags hit hst pcs (ml_hi_file location)
134
		source_unchanged maybe_old_iface;
135
136

      if errs_found then
137
         return (HscFail pcs_ch)
138
      else do {
139

140
141
142
      let no_old_iface = not (isJust maybe_checked_iface)
          what_next | recomp_reqd || no_old_iface = hscRecomp 
                    | otherwise                   = hscNoRecomp
143
      ;
144
145
      what_next ghci_mode dflags have_object mod location 
		maybe_checked_iface hst hit pcs_ch
146
      }}
147
148


149
-- we definitely expect to have the old interface available
150
151
hscNoRecomp ghci_mode dflags have_object 
	    mod location (Just old_iface) hst hit pcs_ch
152
 | ghci_mode == OneShot
153
154
 = do {
      hPutStrLn stderr "compilation IS NOT required";
155
      let { bomb = panic "hscNoRecomp:OneShot" };
156
157
      return (HscNoRecomp pcs_ch bomb bomb)
      }
158
 | otherwise
159
 = do {
160
      when (verbosity dflags >= 1) $
161
162
		hPutStrLn stderr ("Skipping  " ++ 
			compMsg have_object mod location);
163

164
165
      -- CLOSURE
      (pcs_cl, closure_errs, cl_hs_decls) 
166
         <- closeIfaceDecls dflags hit hst pcs_ch old_iface ;
167
      if closure_errs then 
168
         return (HscFail pcs_cl) 
169
170
171
      else do {

      -- TYPECHECK
172
      maybe_tc_result 
173
	<- typecheckIface dflags pcs_cl hst old_iface cl_hs_decls;
174

175
      case maybe_tc_result of {
176
         Nothing -> return (HscFail pcs_cl);
177
         Just (pcs_tc, new_details) ->
178

179
      return (HscNoRecomp pcs_tc new_details old_iface)
180
      }}}
181

182
compMsg use_object mod location =
183
    mod_str ++ take (max 0 (16 - length mod_str)) (repeat ' ')
184
185
186
187
188
    ++" ( " ++ unJust "hscRecomp" (ml_hs_file location) ++ ", "
    ++ (if use_object
	  then unJust "hscRecomp" (ml_obj_file location)
	  else "interpreted")
    ++ " )"
189
190
 where mod_str = moduleUserString mod

191

192
193
hscRecomp ghci_mode dflags have_object 
	  mod location maybe_checked_iface hst hit pcs_ch
194
195
196
197
 = do	{
      	  -- what target are we shooting for?
      	; let toInterp = dopt_HscLang dflags == HscInterpreted

198
199
200
201
      	; when (verbosity dflags >= 1) $
		hPutStrLn stderr ("Compiling " ++ 
			compMsg (not toInterp) mod location);

202
203
204
 	    -------------------
 	    -- PARSE
 	    -------------------
205
206
	; maybe_parsed <- myParseModule dflags 
                             (unJust "hscRecomp:hspp" (ml_hspp_file location))
207
208
209
	; case maybe_parsed of {
      	     Nothing -> return (HscFail pcs_ch);
      	     Just rdr_module -> do {
210
	; let this_mod = mkHomeModule (hsModuleName rdr_module)
211
212
213
214
    
 	    -------------------
 	    -- RENAME
 	    -------------------
215
	; (pcs_rn, print_unqualified, maybe_rn_result) 
216
217
      	     <- _scc_ "Rename" 
		 renameModule dflags hit hst pcs_ch this_mod rdr_module
218
      	; case maybe_rn_result of {
219
      	     Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
220
      	     Just (is_exported, new_iface, rn_hs_decls) -> do {
221
    
222
223
224
225
226
227
228
229
230
 	    -- In interactive mode, we don't want to discard any top-level entities at
	    -- all (eg. do not inline them away during simplification), and retain them
	    -- all in the TypeEnv so they are available from the command line.
	    --
	    -- isGlobalName separates the user-defined top-level names from those
	    -- introduced by the type checker.
	; let dont_discard | ghci_mode == Interactive = isGlobalName
			   | otherwise = is_exported

231
232
233
 	    -------------------
 	    -- TYPECHECK
 	    -------------------
234
235
	; maybe_tc_result 
	    <- _scc_ "TypeCheck" typecheckModule dflags pcs_rn hst new_iface 
236
					     print_unqualified rn_hs_decls 
237
	; case maybe_tc_result of {
238
      	     Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
239
      	     Just (pcs_tc, tc_result) -> do {
240
241
    
 	    -------------------
242
243
 	    -- DESUGAR
 	    -------------------
244
	; (ds_details, foreign_stuff) 
245
246
             <- _scc_ "DeSugar" 
		deSugar dflags pcs_tc hst this_mod print_unqualified tc_result
247

248
249
250
251
252
253
254
255
256
257
258
259
260
261
	; pcs_middle
	    <- if ghci_mode == OneShot 
		  then do init_pcs <- initPersistentCompilerState
			  init_prs <- initPersistentRenamerState
		          let 
			      rules   = pcs_rules pcs_tc	
			      orig_tc = prsOrig (pcs_PRS pcs_tc)
			      new_prs = init_prs{ prsOrig=orig_tc }

			  orig_tc `seq` rules `seq` new_prs `seq`
			    return init_pcs{ pcs_PRS = new_prs,
			                     pcs_rules = rules }
		  else return pcs_tc

262
 	    -------------------
263
264
 	    -- SIMPLIFY
 	    -------------------
265
	; simpl_details
266
	     <- _scc_     "Core2Core"
267
		core2core dflags pcs_middle hst dont_discard ds_details
268
269
270

 	    -------------------
 	    -- TIDY
271
 	    -------------------
272
273
274
275
276
277
278
279
280
281
282
283
	; cg_info_ref <- newIORef Nothing ;
	; let cg_info :: CgInfoEnv
	      cg_info = unsafePerformIO $ do {
			   maybe_cg_env <- readIORef cg_info_ref ;
			   case maybe_cg_env of
			     Just env -> return env
			     Nothing  -> do { printError "Urk! Looked at CgInfo too early!";
					      return emptyNameEnv } }
		-- cg_info_ref will be filled in just after restOfCodeGeneration
		-- Meanwhile, tidyCorePgm is careful not to look at cg_info!

	; (pcs_simpl, tidy_details) 
284
285
	     <- _scc_ "CoreTidy"
	        tidyCorePgm dflags this_mod pcs_middle cg_info simpl_details
286
      
287
288
289
290
291
292
293
	; pcs_final <- if ghci_mode == OneShot then initPersistentCompilerState
				   	       else return pcs_simpl

	-- alive at this point:  
	--	tidy_details
	--	new_iface		

apt's avatar
apt committed
294
	; emitExternalCore dflags new_iface tidy_details 
295
 	    -------------------
296
 	    -- PREPARE FOR CODE GENERATION
297
 	    -------------------
298
	      -- Do saturation and convert to A-normal form
299
	; prepd_details <- _scc_ "CorePrep" corePrepPgm dflags tidy_details
300

301
 	    -------------------
302
 	    -- CONVERT TO STG and COMPLETE CODE GENERATION
303
 	    -------------------
304
305
306
307
308
309
310
	; let
	    ModDetails{md_binds=binds, md_types=env_tc} = prepd_details

	    local_tycons     = typeEnvTyCons  env_tc
	    local_classes    = typeEnvClasses env_tc

 	    imported_module_names = map ideclName (hsModuleImports rdr_module)
311
312
313

	    mod_name_to_Module nm
		 = do m <- findModule nm ; return (fst (fromJust m))
314
315
316

	    (h_code,c_code,fe_binders) = foreign_stuff

317
        ; imported_modules <- mapM mod_name_to_Module imported_module_names
318

319
	; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface )
320
321
322
323
324
325
326
327
328
329
330
331
332
333
	   <- if toInterp
	        then do 
		    -----------------  Generate byte code ------------------
		    (bcos,itbl_env) <- byteCodeGen dflags binds 
					local_tycons local_classes

		    -- Fill in the code-gen info
		    writeIORef cg_info_ref (Just emptyNameEnv)

		    ------------------ BUILD THE NEW ModIface ------------
		    final_iface <- _scc_ "MkFinalIface" 
			  mkFinalIface ghci_mode dflags location 
                                   maybe_checked_iface new_iface tidy_details

334
      		    return ( False, False, Just (bcos,itbl_env), final_iface )
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356

	        else do
		    -----------------  Convert to STG ------------------
		    (stg_binds, cost_centre_info, stg_back_end_info) 
		    	      <- _scc_ "CoreToStg"
		    		  myCoreToStg dflags this_mod binds
		    
		    -- Fill in the code-gen info for the earlier tidyCorePgm
		    writeIORef cg_info_ref (Just stg_back_end_info)

		    ------------------ BUILD THE NEW ModIface ------------
		    final_iface <- _scc_ "MkFinalIface" 
			  mkFinalIface ghci_mode dflags location 
                                   maybe_checked_iface new_iface tidy_details

		    ------------------  Code generation ------------------
		    abstractC <- _scc_ "CodeGen"
		    		  codeGen dflags this_mod imported_modules
		    			 cost_centre_info fe_binders
		    			 local_tycons stg_binds
		    
		    ------------------  Code output -----------------------
357
		    (stub_h_exists, stub_c_exists)
358
359
360
361
		       <- codeOutput dflags this_mod local_tycons
		    	     binds stg_binds
		    	     c_code h_code abstractC
	      		
362
	      	    return (stub_h_exists, stub_c_exists, Nothing, final_iface)
363
364

	; let final_details = tidy_details {md_binds = []} 
365

366
367

      	  -- and the answer is ...
368
	; return (HscRecomp pcs_final
369
370
			    final_details
			    final_iface
371
                            stub_h_exists stub_c_exists
372
      			    maybe_bcos)
373
      	  }}}}}}}
374

375
myParseModule dflags src_filename
376
 = do --------------------------  Parser  ----------------
377
      showPass dflags "Parser"
378
      _scc_  "Parser" do
379
380

      buf <- hGetStringBuffer True{-expand tabs-} src_filename
381

382
      let glaexts | dopt Opt_GlasgowExts dflags = 1#
383
	          | otherwise 		        = 0#
384

385
386
387
      case parseModule buf PState{ bol = 0#, atbol = 1#,
	 		           context = [], glasgow_exts = glaexts,
  			           loc = mkSrcLoc (_PK_ src_filename) 1 } of {
388

389
	PFailed err -> do { hPutStrLn stderr (showSDoc err);
390
                            freeStringBuffer buf;
391
                            return Nothing };
392

393
	POk _ rdr_module@(HsModule mod_name _ _ _ _ _ _) -> do {
394

395
396
      dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_module) ;
      
397
      dumpIfSet_dyn dflags Opt_D_source_stats "Source Statistics"
398
399
			   (ppSourceStats False rdr_module) ;
      
400
      return (Just rdr_module)
401
	-- ToDo: free the string buffer later.
402
      }}
403
404


405
myCoreToStg dflags this_mod tidy_binds
406
 = do 
407
      () <- coreBindsSize tidy_binds `seq` return ()
408
409
410
411
      -- TEMP: the above call zaps some space usage allocated by the
      -- simplifier, which for reasons I don't understand, persists
      -- thoroughout code generation

412
      stg_binds <- _scc_ "Core2Stg" coreToStg dflags tidy_binds
413

414
415
      (stg_binds2, cost_centre_info)
	   <- _scc_ "Core2Stg" stg2stg dflags this_mod stg_binds
416

417
418
419
420
421
422
423
424
425
      let env_rhs :: CgInfoEnv
	  env_rhs = mkNameEnv [ (idName bndr, CgInfo (stgRhsArity rhs) caf_info)
			      | (bind,_) <- stg_binds2, 
			        let caf_info 
				     | stgBindHasCafRefs bind = MayHaveCafRefs
				     | otherwise = NoCafRefs,
			        (bndr,rhs) <- stgBindPairs bind ]

      return (stg_binds2, cost_centre_info, env_rhs)
426
   where
427
428
      stgBindPairs (StgNonRec _ b r) = [(b,r)]
      stgBindPairs (StgRec    _ prs) = prs
apt's avatar
apt committed
429
430


431
432
\end{code}

433

434
435
%************************************************************************
%*									*
436
\subsection{Compiling a do-statement}
437
438
439
%*									*
%************************************************************************

440
\begin{code}
441
#ifdef GHCI
442
hscStmt
443
444
445
446
  :: DynFlags
  -> HomeSymbolTable	
  -> HomeIfaceTable
  -> PersistentCompilerState    -- IN: persistent compiler state
447
448
  -> InteractiveContext		-- Context for compiling
  -> String			-- The statement
449
  -> Bool			-- just treat it as an expression
450
  -> IO ( PersistentCompilerState, 
451
	  Maybe ( [Id], 
452
453
		  Type, 
		  UnlinkedBCOExpr) )
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
\end{code}

When the UnlinkedBCOExpr is linked you get an HValue of type
	IO [HValue]
When you run it you get a list of HValues that should be 
the same length as the list of names; add them to the ClosureEnv.

A naked expression returns a singleton Name [it].

	What you type			The IO [HValue] that hscStmt returns
	-------------			------------------------------------
	let pat = expr		==> 	let pat = expr in return [coerce HVal x, coerce HVal y, ...]
					bindings: [x,y,...]

	pat <- expr		==> 	expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
					bindings: [x,y,...]

	expr (of IO type)	==>	expr >>= \ v -> return [v]
	  [NB: result not printed]	bindings: [it]
	  

	expr (of non-IO type, 
	  result showable)	==>	let v = expr in print v >> return [v]
	  				bindings: [it]
478

479
480
481
482
	expr (of non-IO type, 
	  result not showable)	==>	error

\begin{code}
483
hscStmt dflags hst hit pcs0 icontext stmt just_expr
484
485
   = let 
	InteractiveContext { 
486
	     ic_rn_env   = rn_env, 
487
	     ic_type_env = type_env,
488
	     ic_module   = scope_mod } = icontext
489
490
491
     in
     do { maybe_stmt <- hscParseStmt dflags stmt
	; case maybe_stmt of
492
      	     Nothing -> return (pcs0, Nothing)
493
      	     Just parsed_stmt -> do {
494

495
496
	   let { notExprStmt (ExprStmt _ _ _) = False;
	         notExprStmt _                = True 
497
498
499
500
501
502
503
	       };

	   if (just_expr && notExprStmt parsed_stmt)
		then do hPutStrLn stderr ("not an expression: `" ++ stmt ++ "'")
		        return (pcs0, Nothing)
		else do {

504
		-- Rename it
505
	  (pcs1, print_unqual, maybe_renamed_stmt)
506
507
508
		 <- renameStmt dflags hit hst pcs0 scope_mod 
				iNTERACTIVE rn_env parsed_stmt

509
510
511
	; case maybe_renamed_stmt of
		Nothing -> return (pcs0, Nothing)
		Just (bound_names, rn_stmt) -> do {
512

513
		-- Typecheck it
514
515
	  maybe_tc_return <- 
	    if just_expr 
sof's avatar
sof committed
516
		then case rn_stmt of { (ExprStmt e _ _, decls) -> 
517
		     typecheckExpr dflags pcs1 hst type_env
sof's avatar
sof committed
518
			   print_unqual iNTERACTIVE (e,decls) }
sof's avatar
sof committed
519
520
		else typecheckStmt dflags pcs1 hst type_env
			   print_unqual iNTERACTIVE bound_names rn_stmt
521
522
523
524

	; case maybe_tc_return of
		Nothing -> return (pcs0, Nothing)
		Just (pcs2, tc_expr, bound_ids, ty) ->  do {
525

526
		-- Desugar it
527
	  ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr
528
529
	
		-- Simplify it
530
	; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr
531

532
533
534
		-- Tidy it (temporary, until coreSat does cloning)
	; tidy_expr <- tidyCoreExpr simpl_expr

535
536
		-- Prepare for codegen
	; prepd_expr <- corePrepExpr dflags tidy_expr
537

538
		-- Convert to BCOs
539
	; bcos <- coreExprToBCOs dflags prepd_expr
540
541

	; let
542
		-- Make all the bound ids "global" ids, now that
543
544
545
546
		-- they're notionally top-level bindings.  This is
		-- important: otherwise when we come to compile an expression
		-- using these ids later, the byte code generator will consider
		-- the occurrences to be free rather than global.
547
	     global_bound_ids = map globaliseId bound_ids;
548
	     globaliseId id   = setGlobalIdDetails id VanillaGlobal
549

550
	; return (pcs2, Just (global_bound_ids, ty, bcos))
551

552
553
554
555
     }}}}}

hscParseStmt :: DynFlags -> String -> IO (Maybe RdrNameStmt)
hscParseStmt dflags str
556
557
 = do --------------------------  Parser  ----------------
      showPass dflags "Parser"
558
      _scc_ "Parser" do
559

560
      buf <- stringToStringBuffer str
561

562
      let glaexts | dopt Opt_GlasgowExts dflags = 1#
563
       	          | otherwise  	                = 0#
564

565
      case parseStmt buf PState{ bol = 0#, atbol = 1#,
566
567
	 		         context = [], glasgow_exts = glaexts,
			         loc = mkSrcLoc SLIT("<no file>") 0 } of {
568

569
	PFailed err -> do { hPutStrLn stderr (showSDoc err);
570
--	Not yet implemented in <4.11    freeStringBuffer buf;
571
                            return Nothing };
572

573
574
575
576
	-- no stmt: the line consisted of just space or comments
	POk _ Nothing -> return Nothing;

	POk _ (Just rdr_stmt) -> do {
577

578
579
580
      --ToDo: can't free the string buffer until we've finished this
      -- compilation sweep and all the identifiers have gone away.
      --freeStringBuffer buf;
581
582
      dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_stmt);
      return (Just rdr_stmt)
583
      }}
584
#endif
585
\end{code}
586

587
588
589
590
591
592
593
%************************************************************************
%*									*
\subsection{Initial persistent state}
%*									*
%************************************************************************

\begin{code}
594
initPersistentCompilerState :: IO PersistentCompilerState
595
initPersistentCompilerState 
596
597
  = do prs <- initPersistentRenamerState
       return (
598
        PCS { pcs_PIT   = emptyIfaceTable,
599
              pcs_PTE   = wiredInThingEnv,
600
	      pcs_insts = emptyInstEnv,
601
	      pcs_rules = emptyRuleBase,
602
	      pcs_PRS   = prs
603
604
            }
        )
605

606
initPersistentRenamerState :: IO PersistentRenamerState
607
  = do us <- mkSplitUniqSupply 'r'
608
       return (
609
610
611
        PRS { prsOrig  = NameSupply { nsUniqs = us,
				      nsNames = initOrigNames,
			      	      nsIPs   = emptyFM },
612
613
614
615
	      prsDecls 	 = (emptyNameEnv, 0),
	      prsInsts 	 = (emptyBag, 0),
	      prsRules 	 = (emptyBag, 0),
	      prsImpMods = emptyFM
616
617
            }
        )
618

619
initOrigNames :: FiniteMap (ModuleName,OccName) Name
620
621
622
623
624
625
initOrigNames 
   = grab knownKeyNames `plusFM` grab (map getName wiredInThings)
     where
        grab names = foldl add emptyFM names
        add env name 
           = addToFM env (moduleName (nameModule name), nameOccName name) name
626
\end{code}