HscMain.lhs 20.4 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
3
4
5
6
%
\section[GHC_Main]{Main driver for Glasgow Haskell compiler}

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

13
#include "HsVersions.h"
14

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

29
30
import HsSyn

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

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

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

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

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

82
83
84
85
86
87
88

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

89
\begin{code}
90
data HscResult
91
92
93
94
95
96
97
98
99
100
   -- 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)
rrt's avatar
rrt committed
101
102
	         (Maybe String) 	 -- generated stub_h filename (in TMPDIR)
	         (Maybe String)  	 -- generated stub_c filename (in TMPDIR)
103
	         (Maybe ([UnlinkedBCO],ItblEnv)) -- interpreted code, if any
104
105
             

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

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

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

129
      (pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
130
         <- checkOldIface ghci_mode dflags hit hst pcs 
131
		(unJust "hscMain" (ml_hi_file location))
132
		source_unchanged maybe_old_iface;
133
134

      if errs_found then
135
         return (HscFail pcs_ch)
136
      else do {
137

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


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

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

      -- TYPECHECK
170
171
172
      maybe_tc_result 
	<- typecheckIface dflags pcs_cl hst old_iface (vanillaSyntaxMap, cl_hs_decls);

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

177
      return (HscNoRecomp pcs_tc new_details old_iface)
178
      }}}
179

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

189

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

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

200
201
202
 	    -------------------
 	    -- PARSE
 	    -------------------
203
204
	; maybe_parsed <- myParseModule dflags 
                             (unJust "hscRecomp:hspp" (ml_hspp_file location))
205
206
207
	; case maybe_parsed of {
      	     Nothing -> return (HscFail pcs_ch);
      	     Just rdr_module -> do {
208
	; let this_mod = mkHomeModule (hsModuleName rdr_module)
209
210
211
212
    
 	    -------------------
 	    -- RENAME
 	    -------------------
213
	; (pcs_rn, print_unqualified, maybe_rn_result) 
214
215
      	     <- _scc_ "Rename" 
		 renameModule dflags hit hst pcs_ch this_mod rdr_module
216
      	; case maybe_rn_result of {
217
      	     Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
218
      	     Just (is_exported, new_iface, rn_hs_decls) -> do {
219
    
220
221
222
223
224
225
226
227
228
 	    -- 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

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

 	    -------------------
247
248
 	    -- SIMPLIFY
 	    -------------------
249
	; simpl_details
250
	     <- _scc_     "Core2Core"
251
		core2core dflags pcs_tc hst dont_discard ds_details
252
253
254

 	    -------------------
 	    -- TIDY
255
 	    -------------------
256
257
258
259
260
261
262
263
264
265
266
267
268
	; 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) 
	     <- tidyCorePgm dflags this_mod pcs_tc cg_info simpl_details
269
      
270
 	    -------------------
271
 	    -- PREPARE FOR CODE GENERATION
272
 	    -------------------
273
274
	      -- Do saturation and convert to A-normal form
	; prepd_details <- corePrepPgm dflags tidy_details
275

276
 	    -------------------
277
 	    -- CONVERT TO STG and COMPLETE CODE GENERATION
278
 	    -------------------
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
	; 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)
	    imported_modules = map mod_name_to_Module imported_module_names

	    (h_code,c_code,fe_binders) = foreign_stuff
	
	    pit = pcs_PIT pcs_simpl

	    mod_name_to_Module :: ModuleName -> Module
	    mod_name_to_Module nm
	       = let str_mi = lookupModuleEnvByName hit nm `orElse`
			      lookupModuleEnvByName pit nm `orElse`
			      pprPanic "mod_name_to_Module: no hst or pst mapping for" 
			       	(ppr nm)
		 in  mi_module str_mi

	; (maybe_stub_h_filename, maybe_stub_c_filename,
	   maybe_bcos, final_iface )
	   <- 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

      		    return ( Nothing, Nothing, 
			     Just (bcos,itbl_env), final_iface )

	        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 -----------------------
		    (maybe_stub_h_name, maybe_stub_c_name)
		       <- codeOutput dflags this_mod local_tycons
		    	     binds stg_binds
		    	     c_code h_code abstractC
	      		
	      	    return ( maybe_stub_h_name, maybe_stub_c_name, 
			     Nothing, final_iface )

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

350
351

      	  -- and the answer is ...
352
353
354
	; return (HscRecomp pcs_simpl
			    final_details
			    final_iface
355
                            maybe_stub_h_filename maybe_stub_c_filename
356
      			    maybe_bcos)
357
      	  }}}}}}}
358

359

360

361
362
mkFinalIface ghci_mode dflags location 
	maybe_old_iface new_iface new_details
363
 = case completeIface maybe_old_iface new_iface new_details of
364

365
      (new_iface, Nothing) -- no change in the interfacfe
366
367
368
369
         -> do when (dopt Opt_D_dump_hi_diffs dflags)
                    (printDump (text "INTERFACE UNCHANGED"))
               dumpIfSet_dyn dflags Opt_D_dump_hi
                             "UNCHANGED FINAL INTERFACE" (pprIface new_iface)
370
	       return new_iface
371

372
      (new_iface, Just sdoc_diffs)
373
374
375
376
         -> do dumpIfSet_dyn dflags Opt_D_dump_hi_diffs "INTERFACE HAS CHANGED" 
                                    sdoc_diffs
               dumpIfSet_dyn dflags Opt_D_dump_hi "NEW FINAL INTERFACE" 
                                    (pprIface new_iface)
377
378

               -- Write the interface file, if not in interactive mode
379
380
381
               when (ghci_mode /= Interactive) 
                    (writeIface (unJust "hscRecomp:hi" (ml_hi_file location))
                                new_iface)
382
383
384
               return new_iface


385
myParseModule dflags src_filename
386
 = do --------------------------  Parser  ----------------
387
      showPass dflags "Parser"
388
      _scc_  "Parser" do
389
390

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

392
      let glaexts | dopt Opt_GlasgowExts dflags = 1#
393
	          | otherwise 		        = 0#
394

395
396
397
      case parseModule buf PState{ bol = 0#, atbol = 1#,
	 		           context = [], glasgow_exts = glaexts,
  			           loc = mkSrcLoc (_PK_ src_filename) 1 } of {
398

399
	PFailed err -> do { hPutStrLn stderr (showSDoc err);
400
                            freeStringBuffer buf;
401
                            return Nothing };
402

403
	POk _ rdr_module@(HsModule mod_name _ _ _ _ _ _) -> do {
404

405
406
      dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_module) ;
      
407
      dumpIfSet_dyn dflags Opt_D_source_stats "Source Statistics"
408
409
			   (ppSourceStats False rdr_module) ;
      
410
      return (Just rdr_module)
411
	-- ToDo: free the string buffer later.
412
      }}
413
414


415
myCoreToStg dflags this_mod tidy_binds
416
 = do 
417
      () <- coreBindsSize tidy_binds `seq` return ()
418
419
420
421
      -- TEMP: the above call zaps some space usage allocated by the
      -- simplifier, which for reasons I don't understand, persists
      -- thoroughout code generation

422
      stg_binds <- _scc_ "Core2Stg" coreToStg dflags tidy_binds
423

424
425
      (stg_binds2, cost_centre_info)
	   <- _scc_ "Core2Stg" stg2stg dflags this_mod stg_binds
426

427
428
429
430
431
432
433
434
435
      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)
436
   where
437
438
      stgBindPairs (StgNonRec _ b r) = [(b,r)]
      stgBindPairs (StgRec    _ prs) = prs
439
440
\end{code}

441

442
443
%************************************************************************
%*									*
444
\subsection{Compiling a do-statement}
445
446
447
%*									*
%************************************************************************

448
\begin{code}
449
#ifdef GHCI
450
hscStmt
451
452
453
454
  :: DynFlags
  -> HomeSymbolTable	
  -> HomeIfaceTable
  -> PersistentCompilerState    -- IN: persistent compiler state
455
456
  -> InteractiveContext		-- Context for compiling
  -> String			-- The statement
457
  -> Bool			-- just treat it as an expression
458
  -> IO ( PersistentCompilerState, 
459
	  Maybe ( [Id], 
460
461
		  Type, 
		  UnlinkedBCOExpr) )
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
\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]
486

487
488
489
490
	expr (of non-IO type, 
	  result not showable)	==>	error

\begin{code}
491
hscStmt dflags hst hit pcs0 icontext stmt just_expr
492
493
   = let 
	InteractiveContext { 
494
	     ic_rn_env   = rn_env, 
495
	     ic_type_env = type_env,
496
	     ic_module   = scope_mod } = icontext
497
498
499
     in
     do { maybe_stmt <- hscParseStmt dflags stmt
	; case maybe_stmt of
500
      	     Nothing -> return (pcs0, Nothing)
501
      	     Just parsed_stmt -> do {
502

503
504
505
506
507
508
509
510
511
	   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 {

512
		-- Rename it
513
	  (pcs1, print_unqual, maybe_renamed_stmt)
514
515
516
		 <- renameStmt dflags hit hst pcs0 scope_mod 
				iNTERACTIVE rn_env parsed_stmt

517
518
519
	; case maybe_renamed_stmt of
		Nothing -> return (pcs0, Nothing)
		Just (bound_names, rn_stmt) -> do {
520

521
		-- Typecheck it
522
523
524
525
526
527
528
529
530
531
532
	  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 {
533

534
		-- Desugar it
535
	  ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr
536
537
	
		-- Simplify it
538
	; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr
539

540
541
542
		-- Tidy it (temporary, until coreSat does cloning)
	; tidy_expr <- tidyCoreExpr simpl_expr

543
544
		-- Prepare for codegen
	; prepd_expr <- corePrepExpr dflags tidy_expr
545

546
		-- Convert to BCOs
547
	; bcos <- coreExprToBCOs dflags prepd_expr
548
549

	; let
550
		-- Make all the bound ids "global" ids, now that
551
552
553
554
		-- 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.
555
	     global_bound_ids = map globaliseId bound_ids;
556
	     globaliseId id   = setGlobalIdDetails id VanillaGlobal
557

558
	; return (pcs2, Just (global_bound_ids, ty, bcos))
559

560
561
562
563
     }}}}}

hscParseStmt :: DynFlags -> String -> IO (Maybe RdrNameStmt)
hscParseStmt dflags str
564
565
 = do --------------------------  Parser  ----------------
      showPass dflags "Parser"
566
      _scc_ "Parser" do
567

568
      buf <- stringToStringBuffer str
569

570
      let glaexts | dopt Opt_GlasgowExts dflags = 1#
571
       	          | otherwise  	                = 0#
572

573
      case parseStmt buf PState{ bol = 0#, atbol = 1#,
574
575
	 		         context = [], glasgow_exts = glaexts,
			         loc = mkSrcLoc SLIT("<no file>") 0 } of {
576

577
	PFailed err -> do { hPutStrLn stderr (showSDoc err);
578
--	Not yet implemented in <4.11    freeStringBuffer buf;
579
                            return Nothing };
580

581
582
583
584
	-- no stmt: the line consisted of just space or comments
	POk _ Nothing -> return Nothing;

	POk _ (Just rdr_stmt) -> do {
585

586
587
588
      --ToDo: can't free the string buffer until we've finished this
      -- compilation sweep and all the identifiers have gone away.
      --freeStringBuffer buf;
589
590
      dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_stmt);
      return (Just rdr_stmt)
591
      }}
592
#endif
593
\end{code}
594

595
596
597
598
599
600
601
%************************************************************************
%*									*
\subsection{Initial persistent state}
%*									*
%************************************************************************

\begin{code}
602
initPersistentCompilerState :: IO PersistentCompilerState
603
initPersistentCompilerState 
604
605
  = do prs <- initPersistentRenamerState
       return (
606
        PCS { pcs_PIT   = emptyIfaceTable,
607
              pcs_PTE   = wiredInThingEnv,
608
	      pcs_insts = emptyInstEnv,
609
	      pcs_rules = emptyRuleBase,
610
	      pcs_PRS   = prs
611
612
            }
        )
613

614
initPersistentRenamerState :: IO PersistentRenamerState
615
  = do us <- mkSplitUniqSupply 'r'
616
       return (
617
618
619
        PRS { prsOrig  = NameSupply { nsUniqs = us,
				      nsNames = initOrigNames,
			      	      nsIPs   = emptyFM },
620
621
622
623
	      prsDecls 	 = (emptyNameEnv, 0),
	      prsInsts 	 = (emptyBag, 0),
	      prsRules 	 = (emptyBag, 0),
	      prsImpMods = emptyFM
624
625
            }
        )
626

627
initOrigNames :: FiniteMap (ModuleName,OccName) Name
628
629
630
631
632
633
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
634
635


636
initRules :: PackageRuleBase
637
638
639
initRules = emptyRuleBase
{- SHOULD BE (ish)
            foldl add emptyVarEnv builtinRules
640
	  where
641
	    add env (name,rule) 
642
643
              = extendRuleBase env name rule
-}
644
\end{code}