X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDesugar.lhs;h=c6e75badc51462c1886b8de1356263fe671cbf71;hb=78b72ed1e0ffab668e0d4bb31657942970515e4f;hp=be5ad1e544d291677875c99826858b43298da58a;hpb=2909e581ddf0162ad2c113e17a8f19991862b89c;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs
index be5ad1e..c6e75ba 100644
--- a/ghc/compiler/deSugar/Desugar.lhs
+++ b/ghc/compiler/deSugar/Desugar.lhs
@@ -12,7 +12,7 @@ import DynFlags		( DynFlag(..), DynFlags(..), dopt, GhcMode(..) )
 import StaticFlags	( opt_SccProfilingOn )
 import DriverPhases	( isHsBoot )
 import HscTypes		( ModGuts(..), HscEnv(..), 
-			  Dependencies(..), TypeEnv, IsBootInterface )
+			  Dependencies(..), ForeignStubs(..), TypeEnv, IsBootInterface )
 import HsSyn		( RuleDecl(..), RuleBndr(..), LHsExpr, LRuleDecl )
 import TcRnTypes	( TcGblEnv(..), ImportAvails(..) )
 import MkIface		( mkUsageInfo )
@@ -35,7 +35,7 @@ import Rules		( roughTopNames )
 import CoreLint		( showPass, endPass )
 import CoreFVs		( ruleRhsFreeVars, exprsFreeNames )
 import Packages	  	( PackageState(thPackageId), PackageIdH(..) )
-import ErrUtils		( doIfSet, dumpIfSet_dyn, pprBagOfWarnings, 
+import ErrUtils		( doIfSet, dumpIfSet_dyn, printBagOfWarnings, 
 			  errorsFound, WarnMsg )
 import ListSetOps	( insertList )
 import Outputable
@@ -79,13 +79,16 @@ deSugar hsc_env
 
 	-- Desugar the program
 	; ((all_prs, ds_rules, ds_fords), warns) 
-		<- initDs hsc_env mod rdr_env type_env $ do
-		{ core_prs <- dsTopLHsBinds auto_scc binds
-		; (ds_fords, foreign_prs) <- dsForeigns fords
-		; let all_prs = foreign_prs ++ core_prs
-		      local_bndrs = mkVarSet (map fst all_prs)
-		; ds_rules <- mappM (dsRule mod local_bndrs) rules
-		; return (all_prs, catMaybes ds_rules, ds_fords) }
+		<- case ghcMode (hsc_dflags hsc_env) of
+	             JustTypecheck -> return (([], [], NoStubs), emptyBag)
+	             _             -> initDs hsc_env mod rdr_env type_env $ do
+		                        { core_prs <- dsTopLHsBinds auto_scc binds
+		                        ; (ds_fords, foreign_prs) <- dsForeigns fords
+		                        ; let all_prs = foreign_prs ++ core_prs
+		                              local_bndrs = mkVarSet (map fst all_prs)
+		                        ; ds_rules <- mappM (dsRule mod local_bndrs) rules
+		                        ; return (all_prs, catMaybes ds_rules, ds_fords)
+		                        }
 
 	-- If warnings are considered errors, leave.
 	; if errorsFound dflags (warns, emptyBag)
@@ -185,7 +188,7 @@ deSugarExpr hsc_env this_mod rdr_env type_env tc_expr
 	-- Display any warnings 
 	-- Note: if -Werror is used, we don't signal an error here.
         ; doIfSet (not (isEmptyBag ds_warns))
-		  (printErrs (pprBagOfWarnings ds_warns))
+		  (printBagOfWarnings dflags ds_warns)
 
 	-- Dump output
 	; dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared" (pprCoreExpr core_expr)