unused import

[ghc-hetmet.git] / compiler / main / HscMain.lhs

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 986d2ce..1823910 100644 (file)
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -41,7 +41,7 @@ import PrelNames      ( iNTERACTIVE )
 import Kind            ( Kind )
 import CoreLint                ( lintUnfolding )
 import DsMeta          ( templateHaskellNames )
-import SrcLoc          ( noSrcLoc )
+import SrcLoc          ( noSrcLoc, getLoc )
 import VarEnv          ( emptyTidyEnv )
 #endif
 
@@ -217,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)
@@ -253,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
@@ -390,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
@@ -519,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
 
            -------------------
@@ -894,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
@@ -924,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
      }