X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcBinds.lhs;h=aab8f012ac5eaf68857675df928ef340a0330ea6;hp=d0044d487a2a614f8ad11819f8cb46c05286ccf2;hb=1d1c3c727617630beacacaf33022e1daba06a0bb;hpb=9226af9eef1cc45dd745ce21ddeb36a0be0da708

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index d0044d4..aab8f01 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -424,8 +424,9 @@ tcPrag poly_id (InlineSig v inl)             = return (InlinePrag inl)
 
 tcSpecPrag :: TcId -> LHsType Name -> InlineSpec -> TcM Prag
 tcSpecPrag poly_id hs_ty inl
-  = do	{ spec_ty <- tcHsSigType (FunSigCtxt (idName poly_id)) hs_ty
-	; (co_fn, lie) <- getLIE (tcSubExp (idType poly_id) spec_ty)
+  = do	{ let name = idName poly_id
+	; spec_ty <- tcHsSigType (FunSigCtxt name) hs_ty
+	; (co_fn, lie) <- getLIE (tcSubExp (SpecPragOrigin name) (idType poly_id) spec_ty)
 	; extendLIEs lie
 	; let const_dicts = map instToId lie
 	; return (SpecPrag (mkHsWrap co_fn (HsVar poly_id)) spec_ty const_dicts inl) }