X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscMain.lhs;h=182391034caa4735be63b706aeb43b4d07fdd428;hb=49ea1fa53acd2569b0b74c86a981b0d3779515dd;hp=e170f8fa31f351739aa92ccd39ec4b55d9ba1f24;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index e170f8f..1823910 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -41,13 +41,13 @@ import PrelNames	( iNTERACTIVE )
 import Kind		( Kind )
 import CoreLint		( lintUnfolding )
 import DsMeta		( templateHaskellNames )
-import SrcLoc		( noSrcLoc )
+import SrcLoc		( noSrcLoc, getLoc )
 import VarEnv		( emptyTidyEnv )
 #endif
 
 import Var		( Id )
 import Module		( emptyModuleEnv, ModLocation(..) )
-import RdrName		( GlobalRdrEnv, RdrName )
+import RdrName		( GlobalRdrEnv, RdrName, emptyGlobalRdrEnv )
 import HsSyn		( HsModule, LHsBinds, HsGroup, LIE, LImportDecl )
 import SrcLoc		( Located(..) )
 import StringBuffer	( hGetStringBuffer, stringToStringBuffer )
@@ -74,6 +74,7 @@ import SimplStg		( stg2stg )
 import CodeGen		( codeGen )
 import CmmParse		( parseCmmFile )
 import CodeOutput	( codeOutput )
+import NameEnv          ( emptyNameEnv )
 
 import DynFlags
 import ErrUtils
@@ -114,7 +115,9 @@ newHscEnv dflags
 			   hsc_HPT    = emptyHomePackageTable,
 			   hsc_EPS    = eps_var,
 			   hsc_NC     = nc_var,
-			   hsc_FC     = fc_var } ) }
+			   hsc_FC     = fc_var,
+                           hsc_global_rdr_env = emptyGlobalRdrEnv,
+                           hsc_global_type_env = emptyNameEnv } ) }
 			
 
 knownKeyNames :: [Name]	-- Put here to avoid loops involving DsMeta,
@@ -214,6 +217,9 @@ data CompState
 get :: Comp CompState
 get = Comp $ \s -> return (s,s)
 
+modify :: (CompState -> CompState) -> Comp ()
+modify f = Comp $ \s -> return ((), f s)
+
 gets :: (CompState -> a) -> Comp a
 gets getter = do st <- get
                  return (getter st)
@@ -250,6 +256,10 @@ hscMkCompiler norecomp messenger frontend backend
              <- {-# SCC "checkOldIface" #-}
                 liftIO $ checkOldIface hsc_env mod_summary
                               source_unchanged mbOldIface
+	 -- save the interface that comes back from checkOldIface.
+	 -- In one-shot mode we don't have the old iface until this
+	 -- point, when checkOldIface reads it from the disk.
+	 modify (\s -> s{ compOldIface = mbCheckedIface })
          case mbCheckedIface of 
            Just iface | not recomp_reqd
                -> do messenger mbModIndex False
@@ -387,9 +397,9 @@ batchMsg mb_mod_index recomp
          liftIO $ do
          if recomp
             then showMsg "Compiling "
-            else showMsg "Skipping  "
-
-
+            else if verbosity (hsc_dflags hsc_env) >= 2
+                    then showMsg "Skipping  "
+                    else return ()
 
 --------------------------------------------------------------
 -- FrontEnds
@@ -516,7 +526,7 @@ hscNormalIface simpl_result
 		<- {-# SCC "MkFinalIface" #-}
 		   mkIface hsc_env maybe_old_iface simpl_result details
 	-- Emit external core
-       emitExternalCore (hsc_dflags hsc_env) cg_guts -- Move this? --Lemmih 03/07/2006
+       emitExternalCore (hsc_dflags hsc_env) (mg_exports simpl_result) cg_guts -- Move this? --Lemmih 03/07/2006
        dumpIfaceStats hsc_env
 
  	    -------------------
@@ -891,7 +901,8 @@ compileExpr :: HscEnv
 
 compileExpr hsc_env this_mod rdr_env type_env tc_expr
   = do	{ let { dflags  = hsc_dflags hsc_env ;
-		lint_on = dopt Opt_DoCoreLinting dflags }
+		lint_on = dopt Opt_DoCoreLinting dflags ;
+		!srcspan = getLoc tc_expr }
 	      
 	 	-- Desugar it
 	; ds_expr <- deSugarExpr hsc_env this_mod rdr_env type_env tc_expr
@@ -921,7 +932,7 @@ compileExpr hsc_env this_mod rdr_env type_env tc_expr
 	; bcos <- coreExprToBCOs dflags prepd_expr
 
 		-- link it
-	; hval <- linkExpr hsc_env bcos
+	; hval <- linkExpr hsc_env srcspan bcos
 
 	; return hval
      }