HscMain.lhs 19.5 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	( vanillaSyntaxMap, 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 CmStaticInfo	( GhciMode(..) )
68
import HscStats		( ppSourceStats )
69
import HscTypes
70
import FiniteMap	( FiniteMap, plusFM, emptyFM, addToFM )
71
import OccName		( OccName )
72
import Name		( Name, nameModule, nameOccName, getName, isGlobalName )
73
import NameEnv		( emptyNameEnv, mkNameEnv )
74
import Module		( Module )
75
76

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

78
import Monad		( when )
79
import Maybe		( isJust, fromJust )
80
import IO
81
82
\end{code}

83
84
85
86
87
88
89

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

90
\begin{code}
91
data HscResult
92
93
94
95
96
97
98
99
100
101
   -- 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)
102
103
	         Bool	 	 	-- stub_h exists
	         Bool  		 	-- stub_c exists
104
	         (Maybe ([UnlinkedBCO],ItblEnv)) -- interpreted code, if any
105
106
             

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

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

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

130
      (pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
131
132
         <- _scc_ "checkOldIface"
	    checkOldIface ghci_mode dflags hit hst pcs 
133
		(unJust "hscMain" (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
173
174
      maybe_tc_result 
	<- typecheckIface dflags pcs_cl hst old_iface (vanillaSyntaxMap, cl_hs_decls);

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		

294
 	    -------------------
295
 	    -- PREPARE FOR CODE GENERATION
296
 	    -------------------
297
	      -- Do saturation and convert to A-normal form
298
	; prepd_details <- _scc_ "CorePrep" corePrepPgm dflags tidy_details
299

300
 	    -------------------
301
 	    -- CONVERT TO STG and COMPLETE CODE GENERATION
302
 	    -------------------
303
304
305
306
307
308
309
	; 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)
310
311
312

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

	    (h_code,c_code,fe_binders) = foreign_stuff

316
        ; imported_modules <- mapM mod_name_to_Module imported_module_names
317

318
	; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface )
319
320
321
322
323
324
325
326
327
328
329
330
331
332
	   <- 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

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

	        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 -----------------------
356
		    (stub_h_exists, stub_c_exists)
357
358
359
360
		       <- codeOutput dflags this_mod local_tycons
		    	     binds stg_binds
		    	     c_code h_code abstractC
	      		
361
	      	    return (stub_h_exists, stub_c_exists, Nothing, final_iface)
362
363

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

365
366

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

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

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

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

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

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

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

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


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

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

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

416
417
418
419
420
421
422
423
424
      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)
425
   where
426
427
      stgBindPairs (StgNonRec _ b r) = [(b,r)]
      stgBindPairs (StgRec    _ prs) = prs
428
429
\end{code}

430

431
432
%************************************************************************
%*									*
433
\subsection{Compiling a do-statement}
434
435
436
%*									*
%************************************************************************

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

476
477
478
479
	expr (of non-IO type, 
	  result not showable)	==>	error

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

492
493
494
495
496
497
498
499
500
	   let { notExprStmt (ExprStmt _ _) = False;
	         notExprStmt _              = True 
	       };

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

501
		-- Rename it
502
	  (pcs1, print_unqual, maybe_renamed_stmt)
503
504
505
		 <- renameStmt dflags hit hst pcs0 scope_mod 
				iNTERACTIVE rn_env parsed_stmt

506
507
508
	; case maybe_renamed_stmt of
		Nothing -> return (pcs0, Nothing)
		Just (bound_names, rn_stmt) -> do {
509

510
		-- Typecheck it
511
512
513
514
515
516
517
518
519
520
521
	  maybe_tc_return <- 
	    if just_expr 
		then case rn_stmt of { (syn, ExprStmt e _, decls) -> 
		     typecheckExpr dflags pcs1 hst type_env
			   print_unqual iNTERACTIVE (syn,e,decls) }
		else typecheckStmt dflags pcs1 hst type_env
			   print_unqual iNTERACTIVE bound_names rn_stmt

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

523
		-- Desugar it
524
	  ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr
525
526
	
		-- Simplify it
527
	; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr
528

529
530
531
		-- Tidy it (temporary, until coreSat does cloning)
	; tidy_expr <- tidyCoreExpr simpl_expr

532
533
		-- Prepare for codegen
	; prepd_expr <- corePrepExpr dflags tidy_expr
534

535
		-- Convert to BCOs
536
	; bcos <- coreExprToBCOs dflags prepd_expr
537
538

	; let
539
		-- Make all the bound ids "global" ids, now that
540
541
542
543
		-- 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.
544
	     global_bound_ids = map globaliseId bound_ids;
545
	     globaliseId id   = setGlobalIdDetails id VanillaGlobal
546

547
	; return (pcs2, Just (global_bound_ids, ty, bcos))
548

549
550
551
552
     }}}}}

hscParseStmt :: DynFlags -> String -> IO (Maybe RdrNameStmt)
hscParseStmt dflags str
553
554
 = do --------------------------  Parser  ----------------
      showPass dflags "Parser"
555
      _scc_ "Parser" do
556

557
      buf <- stringToStringBuffer str
558

559
      let glaexts | dopt Opt_GlasgowExts dflags = 1#
560
       	          | otherwise  	                = 0#
561

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

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

570
571
572
573
	-- no stmt: the line consisted of just space or comments
	POk _ Nothing -> return Nothing;

	POk _ (Just rdr_stmt) -> do {
574

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

584
585
586
587
588
589
590
%************************************************************************
%*									*
\subsection{Initial persistent state}
%*									*
%************************************************************************

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

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

616
initOrigNames :: FiniteMap (ModuleName,OccName) Name
617
618
619
620
621
622
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
623
\end{code}