X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsMeta.hs;h=4bcb32efb3fbea9b62054e20de1f40d8c403ced5;hb=3721dd37a707d2aacb5cac814410a78096e28a2c;hp=31a8a0dbf122bc61c300f7eda63392e2664f996f;hpb=6da2fdc8c83b7f3f400496216f06c9b14ab5efc2;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs
index 31a8a0d..4bcb32e 100644
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ b/ghc/compiler/deSugar/DsMeta.hs
@@ -213,20 +213,24 @@ repTyClD (L loc d) = do { dsWarn (loc, hang msg 4 (ppr d)) ;
   where
     msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
 
-repInstD' (L loc (InstDecl ty binds _))
-	-- Ignore user pragmas for now
- = do	{ cxt1 <- repContext cxt
-	; inst_ty1 <- repPred (HsClassP cls tys)
-	; ss <- mkGenSyms (collectHsBindBinders binds)
-	; binds1 <- addBinds ss (rep_binds binds)
-	; decls1 <- coreList decQTyConName binds1
-	; decls2 <- wrapNongenSyms ss decls1
-		-- wrapNonGenSyms: do not clone the class op names!
-		-- They must be called 'op' etc, not 'op34'
-	; i <- repInst cxt1 inst_ty1 decls2
+repInstD' (L loc (InstDecl ty binds _))		-- Ignore user pragmas for now
+ = do	{ i <- addTyVarBinds tvs $ \tv_bndrs ->
+		-- We must bring the type variables into scope, so their occurrences
+		-- don't fail,  even though the binders don't appear in the resulting 
+		-- data structure
+		do {  cxt1 <- repContext cxt
+		   ; inst_ty1 <- repPred (HsClassP cls tys)
+		   ; ss <- mkGenSyms (collectHsBindBinders binds)
+		   ; binds1 <- addBinds ss (rep_binds binds)
+		   ; decls1 <- coreList decQTyConName binds1
+		   ; decls2 <- wrapNongenSyms ss decls1
+		   -- wrapNonGenSyms: do not clone the class op names!
+		   -- They must be called 'op' etc, not 'op34'
+		   ; repInst cxt1 inst_ty1 decls2 }
+
 	; return (loc, i)}
  where
-   (_, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
+   (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
 
 -------------------------------------------------------
 -- 			Constructors