HscMain.lhs 21.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
rrt's avatar
rrt committed
10
		 hscStmt, hscThing,
11
#endif
12
		 initPersistentCompilerState ) where
13

14
#include "HsVersions.h"
15

16
#ifdef GHCI
17
import ByteCodeGen	( byteCodeGen )
18
19
import CoreTidy		( tidyCoreExpr )
import CorePrep		( corePrepExpr )
20
21
import Rename		( renameStmt, renameRdrName )
import RdrName          ( mkUnqual, mkQual )
22
import RdrHsSyn		( RdrNameStmt )
23
import OccName          ( varName, dataName, tcClsName )
24
import Type		( Type )
25
import Id		( Id, idName, setGlobalIdDetails )
26
import IdInfo		( GlobalIdDetails(VanillaGlobal) )
27
import HscTypes		( InteractiveContext(..) )
28
import PrelNames	( iNTERACTIVE )
29
import StringBuffer	( stringToStringBuffer )
rrt's avatar
rrt committed
30
import FastString       ( mkFastString )
31
import Char		( isUpper )
32
import DriverUtil	( split_longest_prefix )
33
34
#endif

35
36
import HsSyn

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

62
63
import Module		( ModuleName, moduleName, mkHomeModule, 
			  moduleUserString )
64
import CmdLineOpts
65
import ErrUtils		( dumpIfSet_dyn, showPass, printError )
66
import Util		( unJust )
67
import UniqSupply	( mkSplitUniqSupply )
68

69
import Bag		( emptyBag )
70
import Outputable
71
import Interpreter
72
import HscStats		( ppSourceStats )
73
import HscTypes
74
import FiniteMap	( FiniteMap, plusFM, emptyFM, addToFM )
75
import OccName		( OccName )
76
import Name		( Name, nameModule, nameOccName, getName, isGlobalName )
77
import NameEnv		( emptyNameEnv, mkNameEnv )
78
import Module		( Module )
79
80

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

82
import Monad		( when )
83
import Maybe		( isJust, fromJust, catMaybes )
84
import IO
apt's avatar
apt committed
85
86

import MkExternalCore	( emitExternalCore )
87
88
\end{code}

89
90
91
92
93
94
95

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

96
\begin{code}
97
data HscResult
98
99
100
101
102
103
104
105
106
107
   -- 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)
108
109
	         Bool	 	 	-- stub_h exists
	         Bool  		 	-- stub_c exists
ken's avatar
ken committed
110
#ifdef GHCI
111
	         (Maybe ([UnlinkedBCO],ItblEnv)) -- interpreted code, if any
ken's avatar
ken committed
112
113
114
#else
	         (Maybe ())			 -- no interpreted code whatsoever
#endif
115

116
117
	-- no errors or warnings; the individual passes
	-- (parse/rename/typecheck) print messages themselves
118

119
hscMain
120
121
  :: GhciMode
  -> DynFlags
122
  -> Module
123
  -> ModuleLocation		-- location info
124
125
  -> Bool			-- True <=> source unchanged
  -> Bool			-- True <=> have an object file (for msgs only)
126
  -> Maybe ModIface		-- old interface, if available
127
  -> HomeSymbolTable		-- for home module ModDetails
128
  -> HomeIfaceTable
129
  -> PersistentCompilerState    -- IN: persistent compiler state
130
  -> IO HscResult
131

132
133
hscMain ghci_mode dflags mod location source_unchanged have_object 
	maybe_old_iface hst hit pcs
134
 = do {
135
136
137
      showPass dflags ("Checking old interface for hs = " 
			++ show (ml_hs_file location)
                	++ ", hspp = " ++ show (ml_hspp_file location));
138

139
      (pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
140
         <- _scc_ "checkOldIface"
141
	    checkOldIface ghci_mode dflags hit hst pcs (ml_hi_file location)
142
		source_unchanged maybe_old_iface;
143
144

      if errs_found then
145
         return (HscFail pcs_ch)
146
      else do {
147

148
149
150
      let no_old_iface = not (isJust maybe_checked_iface)
          what_next | recomp_reqd || no_old_iface = hscRecomp 
                    | otherwise                   = hscNoRecomp
151
      ;
152
153
      what_next ghci_mode dflags have_object mod location 
		maybe_checked_iface hst hit pcs_ch
154
      }}
155
156


157
-- we definitely expect to have the old interface available
158
159
hscNoRecomp ghci_mode dflags have_object 
	    mod location (Just old_iface) hst hit pcs_ch
160
 | ghci_mode == OneShot
161
162
 = do {
      hPutStrLn stderr "compilation IS NOT required";
163
      let { bomb = panic "hscNoRecomp:OneShot" };
164
165
      return (HscNoRecomp pcs_ch bomb bomb)
      }
166
 | otherwise
167
 = do {
168
      when (verbosity dflags >= 1) $
169
170
		hPutStrLn stderr ("Skipping  " ++ 
			compMsg have_object mod location);
171

172
173
      -- CLOSURE
      (pcs_cl, closure_errs, cl_hs_decls) 
174
         <- closeIfaceDecls dflags hit hst pcs_ch old_iface ;
175
      if closure_errs then 
176
         return (HscFail pcs_cl) 
177
178
179
      else do {

      -- TYPECHECK
180
      maybe_tc_result 
181
	<- typecheckIface dflags pcs_cl hst old_iface cl_hs_decls;
182

183
      case maybe_tc_result of {
184
         Nothing -> return (HscFail pcs_cl);
185
         Just (pcs_tc, new_details) ->
186

187
      return (HscNoRecomp pcs_tc new_details old_iface)
188
      }}}
189

190
compMsg use_object mod location =
191
    mod_str ++ take (max 0 (16 - length mod_str)) (repeat ' ')
192
193
194
195
196
    ++" ( " ++ unJust "hscRecomp" (ml_hs_file location) ++ ", "
    ++ (if use_object
	  then unJust "hscRecomp" (ml_obj_file location)
	  else "interpreted")
    ++ " )"
197
198
 where mod_str = moduleUserString mod

199

200
201
hscRecomp ghci_mode dflags have_object 
	  mod location maybe_checked_iface hst hit pcs_ch
202
203
204
205
 = do	{
      	  -- what target are we shooting for?
      	; let toInterp = dopt_HscLang dflags == HscInterpreted

206
207
208
209
      	; when (verbosity dflags >= 1) $
		hPutStrLn stderr ("Compiling " ++ 
			compMsg (not toInterp) mod location);

210
211
212
 	    -------------------
 	    -- PARSE
 	    -------------------
213
214
	; maybe_parsed <- myParseModule dflags 
                             (unJust "hscRecomp:hspp" (ml_hspp_file location))
215
216
217
	; case maybe_parsed of {
      	     Nothing -> return (HscFail pcs_ch);
      	     Just rdr_module -> do {
218
	; let this_mod = mkHomeModule (hsModuleName rdr_module)
219
220
221
222
    
 	    -------------------
 	    -- RENAME
 	    -------------------
223
	; (pcs_rn, print_unqualified, maybe_rn_result) 
224
225
      	     <- _scc_ "Rename" 
		 renameModule dflags hit hst pcs_ch this_mod rdr_module
226
      	; case maybe_rn_result of {
227
      	     Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
228
      	     Just (is_exported, new_iface, rn_hs_decls) -> do {
229
    
230
231
232
233
234
235
236
237
238
 	    -- 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

239
240
241
 	    -------------------
 	    -- TYPECHECK
 	    -------------------
242
243
	; maybe_tc_result 
	    <- _scc_ "TypeCheck" typecheckModule dflags pcs_rn hst new_iface 
244
					     print_unqualified rn_hs_decls 
245
	; case maybe_tc_result of {
246
      	     Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
247
      	     Just (pcs_tc, tc_result) -> do {
248
249
    
 	    -------------------
250
251
 	    -- DESUGAR
 	    -------------------
252
	; (ds_details, foreign_stuff) 
253
254
             <- _scc_ "DeSugar" 
		deSugar dflags pcs_tc hst this_mod print_unqualified tc_result
255

256
257
258
259
260
261
262
263
264
265
266
267
268
269
	; 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

270
 	    -------------------
271
272
 	    -- SIMPLIFY
 	    -------------------
273
	; simpl_details
274
	     <- _scc_     "Core2Core"
275
		core2core dflags pcs_middle hst dont_discard ds_details
276
277
278

 	    -------------------
 	    -- TIDY
279
 	    -------------------
280
281
282
283
284
285
286
287
288
289
290
291
	; 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) 
292
293
	     <- _scc_ "CoreTidy"
	        tidyCorePgm dflags this_mod pcs_middle cg_info simpl_details
294
      
295
296
297
298
299
300
301
	; 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
302
	; emitExternalCore dflags new_iface tidy_details 
303
 	    -------------------
304
 	    -- PREPARE FOR CODE GENERATION
305
 	    -------------------
306
	      -- Do saturation and convert to A-normal form
307
	; prepd_details <- _scc_ "CorePrep" corePrepPgm dflags tidy_details
308

309
 	    -------------------
310
 	    -- CONVERT TO STG and COMPLETE CODE GENERATION
311
 	    -------------------
312
313
314
315
316
317
318
	; 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)
319
320
321

	    mod_name_to_Module nm
		 = do m <- findModule nm ; return (fst (fromJust m))
322
323
324

	    (h_code,c_code,fe_binders) = foreign_stuff

325
        ; imported_modules <- mapM mod_name_to_Module imported_module_names
326

327
	; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface )
328
	   <- if toInterp
ken's avatar
ken committed
329
#ifdef GHCI
330
331
332
333
334
335
336
337
338
339
340
341
342
	        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

343
      		    return ( False, False, Just (bcos,itbl_env), final_iface )
ken's avatar
ken committed
344
345
346
#else
		then error "GHC not compiled with interpreter"
#endif
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368

	        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 -----------------------
369
		    (stub_h_exists, stub_c_exists)
370
371
372
373
		       <- codeOutput dflags this_mod local_tycons
		    	     binds stg_binds
		    	     c_code h_code abstractC
	      		
374
	      	    return (stub_h_exists, stub_c_exists, Nothing, final_iface)
375
376

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

378
379

      	  -- and the answer is ...
380
	; return (HscRecomp pcs_final
381
382
			    final_details
			    final_iface
383
                            stub_h_exists stub_c_exists
384
      			    maybe_bcos)
385
      	  }}}}}}}
386

387
myParseModule dflags src_filename
388
 = do --------------------------  Parser  ----------------
389
      showPass dflags "Parser"
390
      _scc_  "Parser" do
391
392

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

394
      let glaexts | dopt Opt_GlasgowExts dflags = 1#
395
	          | otherwise 		        = 0#
396

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

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

405
	POk _ rdr_module@(HsModule mod_name _ _ _ _ _ _) -> do {
406

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


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

424
      stg_binds <- _scc_ "Core2Stg" coreToStg dflags tidy_binds
425

426
427
      (stg_binds2, cost_centre_info)
	   <- _scc_ "Core2Stg" stg2stg dflags this_mod stg_binds
428

429
430
431
432
433
434
435
436
437
      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)
438
   where
439
440
      stgBindPairs (StgNonRec _ b r) = [(b,r)]
      stgBindPairs (StgRec    _ prs) = prs
apt's avatar
apt committed
441
442


443
444
\end{code}

445

446
447
%************************************************************************
%*									*
448
\subsection{Compiling a do-statement}
449
450
451
%*									*
%************************************************************************

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

491
492
493
494
	expr (of non-IO type, 
	  result not showable)	==>	error

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

507
508
	   let { notExprStmt (ExprStmt _ _ _) = False;
	         notExprStmt _                = True 
509
510
511
512
513
514
515
	       };

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

516
		-- Rename it
517
	  (pcs1, print_unqual, maybe_renamed_stmt)
518
519
520
		 <- renameStmt dflags hit hst pcs0 scope_mod 
				iNTERACTIVE rn_env parsed_stmt

521
522
523
	; case maybe_renamed_stmt of
		Nothing -> return (pcs0, Nothing)
		Just (bound_names, rn_stmt) -> do {
524

525
		-- Typecheck it
526
527
	  maybe_tc_return <- 
	    if just_expr 
sof's avatar
sof committed
528
		then case rn_stmt of { (ExprStmt e _ _, decls) -> 
529
		     typecheckExpr dflags pcs1 hst type_env
sof's avatar
sof committed
530
			   print_unqual iNTERACTIVE (e,decls) }
sof's avatar
sof committed
531
532
		else typecheckStmt dflags pcs1 hst type_env
			   print_unqual iNTERACTIVE bound_names rn_stmt
533
534
535
536

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

538
		-- Desugar it
539
	  ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr
540
541
	
		-- Simplify it
542
	; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr
543

544
545
546
		-- Tidy it (temporary, until coreSat does cloning)
	; tidy_expr <- tidyCoreExpr simpl_expr

547
548
		-- Prepare for codegen
	; prepd_expr <- corePrepExpr dflags tidy_expr
549

550
		-- Convert to BCOs
551
	; bcos <- coreExprToBCOs dflags prepd_expr
552
553

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

562
	; return (pcs2, Just (global_bound_ids, ty, bcos))
563

564
565
566
567
     }}}}}

hscParseStmt :: DynFlags -> String -> IO (Maybe RdrNameStmt)
hscParseStmt dflags str
568
569
 = do --------------------------  Parser  ----------------
      showPass dflags "Parser"
570
      _scc_ "Parser" do
571

572
      buf <- stringToStringBuffer str
573

574
      let glaexts | dopt Opt_GlasgowExts dflags = 1#
575
       	          | otherwise  	                = 0#
576

577
      case parseStmt buf PState{ bol = 0#, atbol = 1#,
578
579
	 		         context = [], glasgow_exts = glaexts,
			         loc = mkSrcLoc SLIT("<no file>") 0 } of {
580

581
	PFailed err -> do { hPutStrLn stderr (showSDoc err);
582
--	Not yet implemented in <4.11    freeStringBuffer buf;
583
                            return Nothing };
584

585
586
587
588
	-- no stmt: the line consisted of just space or comments
	POk _ Nothing -> return Nothing;

	POk _ (Just rdr_stmt) -> do {
589

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

599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
%************************************************************************
%*									*
\subsection{Getting information about an identifer}
%*									*
%************************************************************************

\begin{code}
#ifdef GHCI
hscThing -- like hscStmt, but deals with a single identifier
  :: DynFlags
  -> HomeSymbolTable
  -> HomeIfaceTable
  -> PersistentCompilerState    -- IN: persistent compiler state
  -> InteractiveContext		-- Context for compiling
  -> String			-- The identifier
  -> IO ( PersistentCompilerState,
	  [TyThing] )

hscThing dflags hst hit pcs0 icontext str
   = do let 
	  InteractiveContext {
	     ic_rn_env   = rn_env,
	     ic_type_env = type_env,
	     ic_module   = scope_mod } = icontext

	  rdr_names
	     | '.' `elem` str 
		= [ mkQual ns (fmod,fvar) | ns <- namespaces var ]
	     | otherwise
		= [ mkUnqual ns fstr | ns <- namespaces str ]
 	     where (mod,var) = split_longest_prefix str '.'
		   fmod = mkFastString mod
		   fvar = mkFastString var
		   fstr = mkFastString str
633
634
635
636
	  	   namespaces s 
			| isUpper c || c == ':' = [ tcClsName, dataName ]
			| otherwise             = [ varName ]
		        where c = head s
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658

	(pcs, unqual, maybe_rn_result) <- 
	   renameRdrName dflags hit hst pcs0 scope_mod scope_mod 
		rn_env rdr_names

	case maybe_rn_result of {
	     Nothing -> return (pcs, []);
	     Just (names, decls) -> do {

	maybe_pcs <- typecheckExtraDecls dflags pcs hst unqual
		   	iNTERACTIVE decls;

	case maybe_pcs of {
	     Nothing -> return (pcs, []);
	     Just pcs ->
		let maybe_ty_things = map (lookupType hst (pcs_PTE pcs)) names
		in
		return (pcs, catMaybes maybe_ty_things) }
        }}
#endif
\end{code}

659
660
661
662
663
664
665
%************************************************************************
%*									*
\subsection{Initial persistent state}
%*									*
%************************************************************************

\begin{code}
666
initPersistentCompilerState :: IO PersistentCompilerState
667
initPersistentCompilerState 
668
669
  = do prs <- initPersistentRenamerState
       return (
670
        PCS { pcs_PIT   = emptyIfaceTable,
671
              pcs_PTE   = wiredInThingEnv,
672
	      pcs_insts = emptyInstEnv,
673
	      pcs_rules = emptyRuleBase,
674
	      pcs_PRS   = prs
675
676
            }
        )
677

678
initPersistentRenamerState :: IO PersistentRenamerState
679
  = do us <- mkSplitUniqSupply 'r'
680
       return (
681
682
683
        PRS { prsOrig  = NameSupply { nsUniqs = us,
				      nsNames = initOrigNames,
			      	      nsIPs   = emptyFM },
684
685
686
687
	      prsDecls 	 = (emptyNameEnv, 0),
	      prsInsts 	 = (emptyBag, 0),
	      prsRules 	 = (emptyBag, 0),
	      prsImpMods = emptyFM
688
689
            }
        )
690

691
initOrigNames :: FiniteMap (ModuleName,OccName) Name
692
693
694
695
696
697
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
698
\end{code}