X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDesugar.lhs;h=be26463f4959c0dab7b962103898893845b43f02;hb=508a505e9853984bfdaa3ad855ae3fcbc6d31787;hp=36fd15cf066962a7e5df8646b370849001165b31;hpb=0498d35528e7666b9a77a79a78d2e1e782ff0c0b;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs
index 36fd15c..be26463 100644
--- a/ghc/compiler/deSugar/Desugar.lhs
+++ b/ghc/compiler/deSugar/Desugar.lhs
@@ -9,17 +9,18 @@ module Desugar ( deSugar, deSugarExpr ) where
 #include "HsVersions.h"
 
 import CmdLineOpts	( DynFlag(..), DynFlags(..), dopt, opt_SccProfilingOn )
+import DriverPhases	( isHsBoot )
 import HscTypes		( ModGuts(..), ModGuts, HscEnv(..), GhciMode(..),
 			  Dependencies(..), TypeEnv, IsBootInterface )
 import HsSyn		( RuleDecl(..), RuleBndr(..), HsExpr(..), LHsExpr,
 			  HsBindGroup(..), LRuleDecl, HsBind(..) )
 import TcRnTypes	( TcGblEnv(..), ImportAvails(..) )
 import MkIface		( mkUsageInfo )
-import Id		( Id, setIdExported, idName, idIsFrom, isLocalId )
+import Id		( Id, setIdExported, idName, idIsFrom )
 import Name		( Name, isExternalName )
 import CoreSyn
 import PprCore		( pprIdRules, pprCoreExpr )
-import Subst		( SubstResult(..), substExpr, mkSubst, extendIdSubstList )
+import CoreSubst	( substExpr, mkSubst )
 import DsMonad
 import DsExpr		( dsLExpr )
 import DsBinds		( dsHsBinds, AutoScc(..) )
@@ -35,7 +36,7 @@ import VarSet
 import Bag		( Bag, isEmptyBag, emptyBag, bagToList )
 import CoreLint		( showPass, endPass )
 import CoreFVs		( ruleRhsFreeVars )
-import Packages	  	( PackageState(thPackageId) )
+import Packages	  	( PackageState(thPackageId), PackageIdH(..) )
 import ErrUtils		( doIfSet, dumpIfSet_dyn, pprBagOfWarnings, 
 			  errorsFound, WarnMsg )
 import ListSetOps	( insertList )
@@ -59,6 +60,7 @@ deSugar :: HscEnv -> TcGblEnv -> IO (Bag WarnMsg, Maybe ModGuts)
 
 deSugar hsc_env 
         tcg_env@(TcGblEnv { tcg_mod       = mod,
+			    tcg_src	  = hsc_src,
 		    	    tcg_type_env  = type_env,
 		    	    tcg_imports   = imports,
 		    	    tcg_exports   = exports,
@@ -114,7 +116,7 @@ deSugar hsc_env
 	; th_used   <- readIORef th_var			-- Whether TH is used
 	; let used_names = allUses dus `unionNameSets` dfun_uses
 	      thPackage = thPackageId (pkgState dflags)
-	      pkgs | Just th_id <- thPackage, th_used
+	      pkgs | ExtPackage th_id <- thPackage, th_used
 		   = insertList th_id  (imp_dep_pkgs imports)
 	      	   | otherwise
 		   = imp_dep_pkgs imports
@@ -146,6 +148,7 @@ deSugar hsc_env
 
 	     mod_guts = ModGuts {	
 		mg_module   = mod,
+		mg_boot	    = isHsBoot hsc_src,
 		mg_exports  = exports,
 		mg_deps	    = deps,
 		mg_usages   = usages,
@@ -282,10 +285,11 @@ ds_lhs all_vars lhs
 	-- Substitute the dict bindings eagerly,
 	-- and take the body apart into a (f args) form
     let
-	subst = extendIdSubstList (mkSubst all_vars) pairs
-	pairs = [(id, ContEx subst rhs) | (id,rhs) <- dict_binds']
+	subst = mkSubst all_vars emptyVarEnv (mkVarEnv id_pairs)
+	id_pairs = [(id, substExpr subst rhs) | (id,rhs) <- dict_binds']
 			-- Note recursion here... substitution won't terminate
 			-- if there is genuine recursion... which there isn't
+
 	body'' = substExpr subst body'
     in