X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FInst.lhs;h=e1f3fb77940b1df7bec85b33abee48174065126d;hb=d2f11ea842a25bebd51d6c0c730a756c1d987e25;hp=c1801d6d4dff862913af4b40c52e48a31b4440ae;hpb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;p=ghc-hetmet.git

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index c1801d6..e1f3fb7 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -37,7 +37,6 @@ import HsSyn
 import TcHsSyn
 import TcRnMonad
 import TcEnv
-import TcRnTypes
 import InstEnv
 import FunDeps
 import TcMType
@@ -89,7 +88,7 @@ newMethodFromName :: CtOrigin -> Name -> TcRhoType -> TcM (HsExpr TcId)
 newMethodFromName origin name inst_ty
   = do { id <- tcLookupId name
  	      -- Use tcLookupId not tcLookupGlobalId; the method is almost
-	      -- always a class op, but with -XNoImplicitPrelude GHC is
+	      -- always a class op, but with -XRebindableSyntax GHC is
 	      -- meant to find whatever thing is in scope, and that may
 	      -- be an ordinary function. 
 
@@ -143,7 +142,7 @@ deeplySkolemise
 
 deeplySkolemise skol_info ty
   | Just (arg_tys, tvs, theta, ty') <- tcDeepSplitSigmaTy_maybe ty
-  = do { ids1 <- newSysLocalIds (fsLit "dsk") arg_tys
+  = do { ids1 <- newSysLocalIds (fsLit "dk") arg_tys
        ; tvs1 <- mapM (tcInstSkolTyVar skol_info) tvs
        ; let subst = zipTopTvSubst tvs (mkTyVarTys tvs1)
        ; ev_vars1 <- newEvVars (substTheta subst theta)
@@ -170,14 +169,14 @@ deeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
 deeplyInstantiate orig ty
   | Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty
   = do { (_, tys, subst) <- tcInstTyVars tvs
-       ; ids1  <- newSysLocalIds (fsLit "dsk") (substTys subst arg_tys)
+       ; ids1  <- newSysLocalIds (fsLit "di") (substTys subst arg_tys)
        ; wrap1 <- instCall orig tys (substTheta subst theta)
-       ; (wrap2, rho) <- deeplyInstantiate orig (substTy subst rho)
+       ; (wrap2, rho2) <- deeplyInstantiate orig (substTy subst rho)
        ; return (mkWpLams ids1 
+                    <.> wrap2
                     <.> wrap1 
-                    <.> mkWpEvVarApps ids1
-                    <.> wrap2,
-                 mkFunTys arg_tys rho) }
+                    <.> mkWpEvVarApps ids1,
+                 mkFunTys arg_tys rho2) }
 
   | otherwise = return (idHsWrapper, ty)
 \end{code}
@@ -295,7 +294,7 @@ mkOverLit (HsIsString s) = return (HsString s)
 %*									*
 %************************************************************************
 
-Suppose we are doing the -XNoImplicitPrelude thing, and we encounter
+Suppose we are doing the -XRebindableSyntax thing, and we encounter
 a do-expression.  We have to find (>>) in the current environment, which is
 done by the rename. Then we have to check that it has the same type as
 Control.Monad.(>>).  Or, more precisely, a compatible type. One 'customer' had
@@ -372,8 +371,8 @@ syntaxNameCtxt name orig ty tidy_env = do
 getOverlapFlag :: TcM OverlapFlag
 getOverlapFlag 
   = do 	{ dflags <- getDOpts
-	; let overlap_ok    = dopt Opt_OverlappingInstances dflags
-	      incoherent_ok = dopt Opt_IncoherentInstances  dflags
+	; let overlap_ok    = xopt Opt_OverlappingInstances dflags
+	      incoherent_ok = xopt Opt_IncoherentInstances  dflags
 	      overlap_flag | incoherent_ok = Incoherent
 			   | overlap_ok    = OverlapOk
 			   | otherwise     = NoOverlap
@@ -474,11 +473,9 @@ hasEqualities :: [EvVar] -> Bool
 -- Has a bunch of canonical constraints (all givens) got any equalities in it?
 hasEqualities givens = any (has_eq . evVarPred) givens
   where
-    has_eq (EqPred {}) 	    = True
-    has_eq (IParam {}) 	    = False
-    has_eq (ClassP cls tys) = any has_eq (substTheta subst (classSCTheta cls))
-      where
-        subst = zipOpenTvSubst (classTyVars cls) tys
+    has_eq (EqPred {}) 	     = True
+    has_eq (IParam {}) 	     = False
+    has_eq (ClassP cls _tys) = any has_eq (classSCTheta cls)
 
 ----------------
 tyVarsOfWanteds :: WantedConstraints -> TyVarSet