X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcBinds.lhs;h=3fb4cdf07231c80bd0184fb6dadae172a34f15e4;hb=960223bfc3fd1c2ac4608b837fb83f3bc6b5fd16;hp=a3177a29bda27a9662eb1b875c8b53ce800ff6f1;hpb=9956bafe44c39e07dff0c569dedc5cef3b41dbc7;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index a3177a2..3fb4cdf 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -16,7 +16,7 @@ import HsSyn		( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), InPat(..), Stmt
 			  collectMonoBinders, andMonoBindList, andMonoBinds
 			)
 import RnHsSyn		( RenamedHsBinds, RenamedSig, RenamedMonoBinds )
-import TcHsSyn		( TcHsBinds, TcMonoBinds, TcId, zonkId )
+import TcHsSyn		( TcHsBinds, TcMonoBinds, TcId, zonkId, mkHsLet )
 
 import TcMonad
 import Inst		( Inst, LIE, emptyLIE, mkLIE, plusLIE, plusLIEs, InstOrigin(..),
@@ -27,7 +27,7 @@ import TcEnv		( tcExtendLocalValEnv,
 			  tcLookupTyCon, 
 			  tcGetGlobalTyVars, tcExtendGlobalTyVars
 			)
-import TcSimplify	( tcSimplify, tcSimplifyAndCheck )
+import TcSimplify	( tcSimplify, tcSimplifyAndCheck, tcSimplifyToDicts )
 import TcMonoType	( tcHsType, checkSigTyVars,
 			  TcSigInfo(..), tcTySig, maybeSig, sigCtxt
 			)
@@ -837,6 +837,9 @@ tcSpecSigs (SpecSig name poly_ty src_loc : sigs)
 	-- the spec-pragma-id at the same time
     tcExpr (HsVar name) sig_ty			`thenTc` \ (spec_expr, spec_lie) ->
 
+	-- Squeeze out any Methods (see comments with tcSimplifyToDicts)
+    tcSimplifyToDicts spec_lie			`thenTc` \ (spec_lie1, spec_binds) ->
+
     	-- Just specialise "f" by building a SpecPragmaId binding
 	-- It is the thing that makes sure we don't prematurely 
 	-- dead-code-eliminate the binding we are really interested in.
@@ -844,8 +847,8 @@ tcSpecSigs (SpecSig name poly_ty src_loc : sigs)
 
 	-- Do the rest and combine
     tcSpecSigs sigs			`thenTc` \ (binds_rest, lie_rest) ->
-    returnTc (binds_rest `andMonoBinds` VarMonoBind spec_id spec_expr,
-	      lie_rest   `plusLIE`      spec_lie)
+    returnTc (binds_rest `andMonoBinds` VarMonoBind spec_id (mkHsLet spec_binds spec_expr),
+	      lie_rest   `plusLIE`      spec_lie1)
 
 tcSpecSigs (other_sig : sigs) = tcSpecSigs sigs
 tcSpecSigs []		      = returnTc (EmptyMonoBinds, emptyLIE)