Improve error messages for type functions

[ghc-hetmet.git] / compiler / typecheck / TcExpr.lhs

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 540292c..b255fdb 100644 (file)
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -1069,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)
@@ -1147,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.
+
 
 %************************************************************************
 %*                                                                     *
@@ -1189,9 +1198,11 @@ tcRecordBinds data_con arg_tys (HsRecFields rbinds dd)
        do { rhs' <- tcPolyExprNC rhs field_ty
           ; let field_id = mkUserLocal (nameOccName field_lbl)
                                        (nameUnique field_lbl)
-                                       field_ty loc
-               -- The field_id has the *unique* of the selector Id
-               -- but is a LocalId with the appropriate type of the RHS
+                                       field_ty loc 
+               -- Yuk: the field_id has the *unique* of the selector Id
+               --          (so we can find it easily)
+               --      but is a LocalId with the appropriate type of the RHS
+               --          (so the desugarer knows the type of local binder to make)
           ; return (Just (fld { hsRecFieldId = L loc field_id, hsRecFieldArg = rhs' })) }
       | otherwise
       = do { addErrTc (badFieldCon data_con field_lbl)