X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcExpr.lhs;h=b255fdbc75a348646a3923207409222ad7cd29c7;hb=da2e18b9ab29131bda1ac8e3962dc50b635589a5;hp=687f3d59187f5b40ef3c4367c32a285d8e3b51da;hpb=d95ce839533391e7118257537044f01cbb1d6694;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 687f3d5..b255fdb 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -809,12 +809,12 @@ tcId :: InstOrigin
      -> BoxyRhoType				-- Result type
      -> TcM (HsExpr TcId)
 tcId orig fun_name res_ty
-  = do	{ (fun, fun_ty) <- lookupFun orig fun_name
-        ; traceTc (text "tcId" <+> ppr fun_name <+> (ppr fun_ty $$ ppr res_ty))
-	
+  = do	{ traceTc (text "tcId" <+> ppr fun_name <+> ppr res_ty)
+	; (fun, fun_ty) <- lookupFun orig fun_name
+
 	-- Split up the function type
 	; let (tv_theta_prs, fun_tau) = tcMultiSplitSigmaTy fun_ty
-	      qtvs = concatMap fst tv_theta_prs  	-- Quantified tyvars
+	      qtvs = concatMap fst tv_theta_prs	-- Quantified tyvars
 	      tau_qtvs = exactTyVarsOfType fun_tau	-- Mentioned in the tau part
 	; qtv_tys <- preSubType qtvs tau_qtvs fun_tau res_ty
 
@@ -822,8 +822,6 @@ tcId orig fun_name res_ty
 	; let res_subst = zipTopTvSubst qtvs qtv_tys
 	      fun_tau'  = substTy res_subst fun_tau
 
-        ; traceTc (text "tcId2" <+> ppr fun_name <+> (ppr qtvs $$ ppr qtv_tys))
-
 	; co_fn <- tcSubExp orig fun_tau' res_ty
 
 	-- And pack up the results
@@ -1071,6 +1069,9 @@ lookupFun orig id_name
 	    	-- nor does it need the 'lifting' treatment
 
     	    ATcId { tct_id = id, tct_type = ty, tct_co = mb_co, tct_level = lvl }
+	    	| isNaughtyRecordSelector id -> failWithTc (naughtyRecordSel id)
+		  			  -- Note [Local record selectors]
+		| otherwise
 		-> do { thLocalId orig id ty lvl
 		      ; case mb_co of
 			  Unrefineable    -> return (HsVar id, ty)
@@ -1149,6 +1150,12 @@ thBrackId orig id ps_var lie_var
 #endif /* GHCI */
 \end{code}
 
+Local record selectors
+~~~~~~~~~~~~~~~~~~~~~~
+Record selectors for TyCons in this module are ordinary local bindings,
+which show up as ATcIds rather than AGlobals.  So we need to check for
+naughtiness in both branches.  c.f. TcTyClsBindings.mkAuxBinds.
+
 
 %************************************************************************
 %*									*