From: simonmar <unknown>
Date: Tue, 1 May 2001 09:10:32 +0000 (+0000)
Subject: [project @ 2001-05-01 09:10:32 by simonmar]
X-Git-Tag: Approximately_9120_patches~2047
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4af93602d4ff7b847e55c377604d3e42f401a099;p=ghc-hetmet.git

[project @ 2001-05-01 09:10:32 by simonmar]
Add some {-# SCC #-} annotations, and fix a space leak.
---

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 3037b1b..52587d2 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -35,6 +35,7 @@ import StringBuffer	( hGetStringBuffer, freeStringBuffer )
 import Parser
 import Lex		( PState(..), ParseResult(..) )
 import SrcLoc		( mkSrcLoc )
+import Finder		( findModule )
 import Rename		( checkOldIface, renameModule, closeIfaceDecls )
 import Rules		( emptyRuleBase )
 import PrelInfo		( wiredInThingEnv, wiredInThings )
@@ -76,7 +77,7 @@ import Maybes		( orElse )
 import IOExts		( newIORef, readIORef, writeIORef, unsafePerformIO )
 
 import Monad		( when )
-import Maybe		( isJust )
+import Maybe		( isJust, fromJust )
 import IO
 \end{code}
 
@@ -128,7 +129,8 @@ hscMain ghci_mode dflags mod location source_unchanged have_object
                 	++ ", hspp = " ++ show (ml_hspp_file location));
 
       (pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
-         <- checkOldIface ghci_mode dflags hit hst pcs 
+         <- _scc_ "checkOldIface"
+	    checkOldIface ghci_mode dflags hit hst pcs 
 		(unJust "hscMain" (ml_hi_file location))
 		source_unchanged maybe_old_iface;
 
@@ -244,12 +246,26 @@ hscRecomp ghci_mode dflags have_object
              <- _scc_ "DeSugar" 
 		deSugar dflags pcs_tc hst this_mod print_unqualified tc_result
 
+	; 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
+
  	    -------------------
  	    -- SIMPLIFY
  	    -------------------
 	; simpl_details
 	     <- _scc_     "Core2Core"
-		core2core dflags pcs_tc hst dont_discard ds_details
+		core2core dflags pcs_middle hst dont_discard ds_details
 
  	    -------------------
  	    -- TIDY
@@ -266,13 +282,21 @@ hscRecomp ghci_mode dflags have_object
 		-- Meanwhile, tidyCorePgm is careful not to look at cg_info!
 
 	; (pcs_simpl, tidy_details) 
-	     <- tidyCorePgm dflags this_mod pcs_tc cg_info simpl_details
+	     <- _scc_ "CoreTidy"
+	        tidyCorePgm dflags this_mod pcs_middle cg_info simpl_details
       
+	; pcs_final <- if ghci_mode == OneShot then initPersistentCompilerState
+				   	       else return pcs_simpl
+
+	-- alive at this point:  
+	--	tidy_details
+	--	new_iface		
+
  	    -------------------
  	    -- PREPARE FOR CODE GENERATION
  	    -------------------
 	      -- Do saturation and convert to A-normal form
-	; prepd_details <- corePrepPgm dflags tidy_details
+	; prepd_details <- _scc_ "CorePrep" corePrepPgm dflags tidy_details
 
  	    -------------------
  	    -- CONVERT TO STG and COMPLETE CODE GENERATION
@@ -284,19 +308,13 @@ hscRecomp ghci_mode dflags have_object
 	    local_classes    = typeEnvClasses env_tc
 
  	    imported_module_names = map ideclName (hsModuleImports rdr_module)
-	    imported_modules = map mod_name_to_Module imported_module_names
+
+	    mod_name_to_Module nm
+		 = do m <- findModule nm ; return (fst (fromJust m))
 
 	    (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
+        ; imported_modules <- mapM mod_name_to_Module imported_module_names
 
 	; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface )
 	   <- if toInterp
@@ -347,7 +365,7 @@ hscRecomp ghci_mode dflags have_object
 
 
       	  -- and the answer is ...
-	; return (HscRecomp pcs_simpl
+	; return (HscRecomp pcs_final
 			    final_details
 			    final_iface
                             stub_h_exists stub_c_exists