X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=2e813146f1ffb3499df374a47690a00dc20f7668;hb=f1a90f54590e5a7a32a9c3ef2950740922b1f425;hp=0d7ba6ab916d560b9ad7f411d8ca02f71d70211f;hpb=9ba922ee06b048774d7a82964867ff768a78126e;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 0d7ba6a..2e81314 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -343,16 +343,17 @@ tcBracket brack res_ty
        ; lie_var <- getConstraintVar
        ; let brack_stage = Brack cur_stage pending_splices lie_var
 
-       ; (meta_ty, lie) <- setStage brack_stage $
-                           captureConstraints $
-                           tc_bracket cur_stage brack
-
-       ; simplifyBracket lie
-
-	-- Make the expected type have the right shape
-       ; _ <- unifyType meta_ty res_ty
-
-	-- Return the original expression, not the type-decorated one
+          -- We want to check that there aren't any constraints that
+          -- can't be satisfied (e.g. Show Foo, where Foo has no Show
+          -- instance), but we aren't otherwise interested in the
+          -- results. Nor do we care about ambiguous dictionaries etc.
+          -- We will type check this bracket again at its usage site.
+       ; _ <- newImplication BracketSkol [] [] $
+              setStage brack_stage $
+              do { meta_ty <- tc_bracket cur_stage brack
+                 ; unifyType meta_ty res_ty }
+
+        -- Return the original expression, not the type-decorated one
        ; pendings <- readMutVar pending_splices
        ; return (noLoc (HsBracketOut brack pendings)) }
 
@@ -940,11 +941,11 @@ illegalBracket = ptext (sLit "Template Haskell brackets cannot be nested (withou
 %************************************************************************
 
 \begin{code}
-lookupClassInstances :: TH.Name -> [TH.Type] -> TcM [TH.Name]
+lookupClassInstances :: TH.Name -> [TH.Type] -> TcM [TH.ClassInstance]
 lookupClassInstances c ts
    = do { loc <- getSrcSpanM
-        ; case convertToHsPred loc (TH.ClassP c ts) of
-            Left msg -> failWithTc msg
+        ; case convertToHsPred loc (TH.ClassP c ts) of {
+            Left msg -> failWithTc msg;
             Right rdr_pred -> do
         { rn_pred <- rnLPred doc rdr_pred	-- Rename
         ; kc_pred <- kcHsLPred rn_pred		-- Kind check
@@ -953,8 +954,7 @@ lookupClassInstances c ts
 	-- Now look up instances
         ; inst_envs <- tcGetInstEnvs
         ; let (matches, unifies) = lookupInstEnv inst_envs cls tys
-              dfuns = map is_dfun (map fst matches ++ unifies)
-        ; return (map reifyName dfuns) } }
+        ; mapM reifyClassInstance (map fst matches ++ unifies) } } }
   where
     doc = ptext (sLit "TcSplice.classInstances")
 \end{code}