ghc/compiler/typecheck/TcExpr.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[TcExpr]{Typecheck an expression}
   5
   6 \begin{code}
   7 module TcExpr ( tcApp, tcExpr, tcMonoExpr, tcPolyExpr, tcId ) where
   8
   9 #include "HsVersions.h"
  10
  11 import HsSyn            ( HsExpr(..), HsLit(..), ArithSeqInfo(..),
  12                           HsMatchContext(..), HsDoContext(..), mkMonoBind
  13                         )
  14 import RnHsSyn          ( RenamedHsExpr, RenamedRecordBinds )
  15 import TcHsSyn          ( TcExpr, TcRecordBinds, mkHsLet )
  16
  17 import TcMonad
  18 import BasicTypes       ( RecFlag(..),  isMarkedStrict )
  19 import Inst             ( InstOrigin(..),
  20                           LIE, mkLIE, emptyLIE, unitLIE, plusLIE, plusLIEs,
  21                           newOverloadedLit, newMethod, newIPDict,
  22                           newDicts,
  23                           instToId, tcInstId
  24                         )
  25 import TcBinds          ( tcBindsAndThen )
  26 import TcEnv            ( tcLookupClass, tcLookupGlobalId, tcLookupGlobal_maybe,
  27                           tcLookupTyCon, tcLookupDataCon, tcLookupId,
  28                           tcExtendGlobalTyVars
  29                         )
  30 import TcMatches        ( tcMatchesCase, tcMatchLambda, tcStmts )
  31 import TcMonoType       ( tcHsSigType, UserTypeCtxt(..), checkSigTyVars, sigCtxt )
  32 import TcPat            ( badFieldCon, simpleHsLitTy )
  33 import TcSimplify       ( tcSimplifyCheck, tcSimplifyIPs )
  34 import TcMType          ( tcInstTyVars, tcInstType,
  35                           newTyVarTy, newTyVarTys, zonkTcType,
  36                           unifyTauTy, unifyFunTy, unifyListTy, unifyTupleTy
  37                         )
  38 import TcType           ( tcSplitFunTys, tcSplitTyConApp,
  39                           isQualifiedTy,
  40                           mkFunTy, mkAppTy, mkTyConTy,
  41                           mkTyConApp, mkClassPred, tcFunArgTy,
  42                           isTauTy, tyVarsOfType, tyVarsOfTypes,
  43                           liftedTypeKind, openTypeKind, mkArrowKind,
  44                           tcSplitSigmaTy, tcTyConAppTyCon,
  45                           tidyOpenType
  46                         )
  47 import FieldLabel       ( FieldLabel, fieldLabelName, fieldLabelType, fieldLabelTyCon )
  48 import Id               ( idType, recordSelectorFieldLabel, isRecordSelector )
  49 import DataCon          ( dataConFieldLabels, dataConSig,
  50                           dataConStrictMarks
  51                         )
  52 import Name             ( Name )
  53 import TyCon            ( TyCon, tyConTyVars, isAlgTyCon, tyConDataCons )
  54 import Subst            ( mkTopTyVarSubst, substTheta, substTy )
  55 import VarSet           ( elemVarSet )
  56 import TysWiredIn       ( boolTy, mkListTy, listTyCon )
  57 import PrelNames        ( cCallableClassName,
  58                           cReturnableClassName,
  59                           enumFromName, enumFromThenName,
  60                           enumFromToName, enumFromThenToName,
  61                           thenMName, failMName, returnMName, ioTyConName
  62                         )
  63 import Outputable
  64 import ListSetOps       ( minusList )
  65 import Util
  66 import CmdLineOpts
  67 import HscTypes         ( TyThing(..) )
  68
  69 \end{code}
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection{Main wrappers}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 \begin{code}
  78 tcExpr :: RenamedHsExpr                 -- Expession to type check
  79         -> TcType                       -- Expected type (could be a polytpye)
  80         -> TcM (TcExpr, LIE)
  81
  82 tcExpr expr ty | isQualifiedTy ty = -- Polymorphic case
  83                                     tcPolyExpr expr ty  `thenTc` \ (expr', lie, _, _, _) ->
  84                                     returnTc (expr', lie)
  85
  86                | otherwise        = -- Monomorphic case
  87                                     tcMonoExpr expr ty
  88 \end{code}
  89
  90
  91 %************************************************************************
  92 %*                                                                      *
  93 \subsection{@tcPolyExpr@ typchecks an application}
  94 %*                                                                      *
  95 %************************************************************************
  96
  97 \begin{code}
  98 -- tcPolyExpr is like tcMonoExpr, except that the expected type
  99 -- can be a polymorphic one.
 100 tcPolyExpr :: RenamedHsExpr
 101            -> TcType                            -- Expected type
 102            -> TcM (TcExpr, LIE,         -- Generalised expr with expected type, and LIE
 103                      TcExpr, TcTauType, LIE)    -- Same thing, but instantiated; tau-type returned
 104
 105 tcPolyExpr arg expected_arg_ty
 106   =     -- Ha!  The argument type of the function is a for-all type,
 107         -- An example of rank-2 polymorphism.
 108
 109         -- To ensure that the forall'd type variables don't get unified with each
 110         -- other or any other types, we make fresh copy of the alleged type
 111     tcInstType expected_arg_ty          `thenNF_Tc` \ (sig_tyvars, sig_theta, sig_tau) ->
 112     let
 113         free_tvs = tyVarsOfType expected_arg_ty
 114     in
 115         -- Type-check the arg and unify with expected type
 116     tcMonoExpr arg sig_tau                              `thenTc` \ (arg', lie_arg) ->
 117
 118         -- Check that the sig_tyvars havn't been constrained
 119         -- The interesting bit here is that we must include the free variables
 120         -- of the expected arg ty.  Here's an example:
 121         --       runST (newVar True)
 122         -- Here, if we don't make a check, we'll get a type (ST s (MutVar s Bool))
 123         -- for (newVar True), with s fresh.  Then we unify with the runST's arg type
 124         -- forall s'. ST s' a. That unifies s' with s, and a with MutVar s Bool.
 125         -- So now s' isn't unconstrained because it's linked to a.
 126         -- Conclusion: include the free vars of the expected arg type in the
 127         -- list of "free vars" for the signature check.
 128
 129     tcExtendGlobalTyVars free_tvs                                 $
 130     tcAddErrCtxtM (sigCtxt sig_msg sig_tyvars sig_theta sig_tau)  $
 131
 132     newDicts SignatureOrigin sig_theta          `thenNF_Tc` \ sig_dicts ->
 133     tcSimplifyCheck
 134         (text "the type signature of an expression")
 135         sig_tyvars
 136         sig_dicts lie_arg                       `thenTc` \ (free_insts, inst_binds) ->
 137
 138     checkSigTyVars sig_tyvars free_tvs          `thenTc` \ zonked_sig_tyvars ->
 139
 140     let
 141             -- This HsLet binds any Insts which came out of the simplification.
 142             -- It's a bit out of place here, but using AbsBind involves inventing
 143             -- a couple of new names which seems worse.
 144         generalised_arg = TyLam zonked_sig_tyvars $
 145                           DictLam (map instToId sig_dicts) $
 146                           mkHsLet inst_binds $
 147                           arg'
 148     in
 149     returnTc ( generalised_arg, free_insts,
 150                arg', sig_tau, lie_arg )
 151   where
 152     sig_msg = ptext SLIT("When checking an expression type signature")
 153 \end{code}
 154
 155 %************************************************************************
 156 %*                                                                      *
 157 \subsection{The TAUT rules for variables}
 158 %*                                                                      *
 159 %************************************************************************
 160
 161 \begin{code}
 162 tcMonoExpr :: RenamedHsExpr             -- Expession to type check
 163            -> TcTauType                 -- Expected type (could be a type variable)
 164            -> TcM (TcExpr, LIE)
 165
 166 tcMonoExpr (HsVar name) res_ty
 167   = tcId name                   `thenNF_Tc` \ (expr', lie, id_ty) ->
 168     unifyTauTy res_ty id_ty     `thenTc_`
 169
 170     -- Check that the result type doesn't have any nested for-alls.
 171     -- For example, a "build" on its own is no good; it must be
 172     -- applied to something.
 173     checkTc (isTauTy id_ty)
 174             (lurkingRank2Err name id_ty) `thenTc_`
 175
 176     returnTc (expr', lie)
 177 \end{code}
 178
 179 \begin{code}
 180 tcMonoExpr (HsIPVar name) res_ty
 181   = newIPDict (IPOcc name) name res_ty          `thenNF_Tc` \ ip ->
 182     returnNF_Tc (HsIPVar (instToId ip), unitLIE ip)
 183 \end{code}
 184
 185 %************************************************************************
 186 %*                                                                      *
 187 \subsection{Other expression forms}
 188 %*                                                                      *
 189 %************************************************************************
 190
 191 \begin{code}
 192 tcMonoExpr (HsLit lit)     res_ty = tcLit lit res_ty
 193 tcMonoExpr (HsOverLit lit) res_ty = newOverloadedLit (LiteralOrigin lit) lit res_ty
 194 tcMonoExpr (HsPar expr)    res_ty = tcMonoExpr expr res_ty
 195
 196 tcMonoExpr (NegApp expr neg_name) res_ty
 197   = tcMonoExpr (HsApp (HsVar neg_name) expr) res_ty
 198
 199 tcMonoExpr (HsLam match) res_ty
 200   = tcMatchLambda match res_ty          `thenTc` \ (match',lie) ->
 201     returnTc (HsLam match', lie)
 202
 203 tcMonoExpr (HsApp e1 e2) res_ty = accum e1 [e2]
 204   where
 205     accum (HsApp e1 e2) args = accum e1 (e2:args)
 206     accum fun args
 207       = tcApp fun args res_ty   `thenTc` \ (fun', args', lie) ->
 208         returnTc (foldl HsApp fun' args', lie)
 209
 210 -- equivalent to (op e1) e2:
 211 tcMonoExpr (OpApp arg1 op fix arg2) res_ty
 212   = tcApp op [arg1,arg2] res_ty `thenTc` \ (op', [arg1', arg2'], lie) ->
 213     returnTc (OpApp arg1' op' fix arg2', lie)
 214 \end{code}
 215
 216 Note that the operators in sections are expected to be binary, and
 217 a type error will occur if they aren't.
 218
 219 \begin{code}
 220 -- Left sections, equivalent to
 221 --      \ x -> e op x,
 222 -- or
 223 --      \ x -> op e x,
 224 -- or just
 225 --      op e
 226
 227 tcMonoExpr in_expr@(SectionL arg op) res_ty
 228   = tcApp op [arg] res_ty               `thenTc` \ (op', [arg'], lie) ->
 229
 230         -- Check that res_ty is a function type
 231         -- Without this check we barf in the desugarer on
 232         --      f op = (3 `op`)
 233         -- because it tries to desugar to
 234         --      f op = \r -> 3 op r
 235         -- so (3 `op`) had better be a function!
 236     tcAddErrCtxt (sectionLAppCtxt in_expr) $
 237     unifyFunTy res_ty                   `thenTc_`
 238
 239     returnTc (SectionL arg' op', lie)
 240
 241 -- Right sections, equivalent to \ x -> x op expr, or
 242 --      \ x -> op x expr
 243
 244 tcMonoExpr in_expr@(SectionR op expr) res_ty
 245   = tcExpr_id op                `thenTc`    \ (op', lie1, op_ty) ->
 246     tcAddErrCtxt (sectionRAppCtxt in_expr) $
 247     split_fun_ty op_ty 2 {- two args -}                 `thenTc` \ ([arg1_ty, arg2_ty], op_res_ty) ->
 248     tcMonoExpr expr arg2_ty                             `thenTc` \ (expr',lie2) ->
 249     unifyTauTy res_ty (mkFunTy arg1_ty op_res_ty)       `thenTc_`
 250     returnTc (SectionR op' expr', lie1 `plusLIE` lie2)
 251 \end{code}
 252
 253 The interesting thing about @ccall@ is that it is just a template
 254 which we instantiate by filling in details about the types of its
 255 argument and result (ie minimal typechecking is performed).  So, the
 256 basic story is that we allocate a load of type variables (to hold the
 257 arg/result types); unify them with the args/result; and store them for
 258 later use.
 259
 260 \begin{code}
 261 tcMonoExpr e0@(HsCCall lbl args may_gc is_casm ignored_fake_result_ty) res_ty
 262
 263   = getDOptsTc                          `thenNF_Tc` \ dflags ->
 264
 265     checkTc (not (is_casm && dopt_HscLang dflags /= HscC))
 266         (vcat [text "_casm_ is only supported when compiling via C (-fvia-C).",
 267                text "Either compile with -fvia-C, or, better, rewrite your code",
 268                text "to use the foreign function interface.  _casm_s are deprecated",
 269                text "and support for them may one day disappear."])
 270                                         `thenTc_`
 271
 272     -- Get the callable and returnable classes.
 273     tcLookupClass cCallableClassName    `thenNF_Tc` \ cCallableClass ->
 274     tcLookupClass cReturnableClassName  `thenNF_Tc` \ cReturnableClass ->
 275     tcLookupTyCon ioTyConName           `thenNF_Tc` \ ioTyCon ->
 276     let
 277         new_arg_dict (arg, arg_ty)
 278           = newDicts (CCallOrigin (_UNPK_ lbl) (Just arg))
 279                      [mkClassPred cCallableClass [arg_ty]]      `thenNF_Tc` \ arg_dicts ->
 280             returnNF_Tc arg_dicts       -- Actually a singleton bag
 281
 282         result_origin = CCallOrigin (_UNPK_ lbl) Nothing {- Not an arg -}
 283     in
 284
 285         -- Arguments
 286     let n_args = length args
 287         tv_idxs | n_args == 0 = []
 288                 | otherwise   = [1..n_args]
 289     in
 290     newTyVarTys (length tv_idxs) openTypeKind           `thenNF_Tc` \ arg_tys ->
 291     tcMonoExprs args arg_tys                            `thenTc`    \ (args', args_lie) ->
 292
 293         -- The argument types can be unlifted or lifted; the result
 294         -- type must, however, be lifted since it's an argument to the IO
 295         -- type constructor.
 296     newTyVarTy liftedTypeKind           `thenNF_Tc` \ result_ty ->
 297     let
 298         io_result_ty = mkTyConApp ioTyCon [result_ty]
 299     in
 300     unifyTauTy res_ty io_result_ty              `thenTc_`
 301
 302         -- Construct the extra insts, which encode the
 303         -- constraints on the argument and result types.
 304     mapNF_Tc new_arg_dict (zipEqual "tcMonoExpr:CCall" args arg_tys)    `thenNF_Tc` \ ccarg_dicts_s ->
 305     newDicts result_origin [mkClassPred cReturnableClass [result_ty]]   `thenNF_Tc` \ ccres_dict ->
 306     returnTc (HsCCall lbl args' may_gc is_casm io_result_ty,
 307               mkLIE (ccres_dict ++ concat ccarg_dicts_s) `plusLIE` args_lie)
 308 \end{code}
 309
 310 \begin{code}
 311 tcMonoExpr (HsSCC lbl expr) res_ty
 312   = tcMonoExpr expr res_ty              `thenTc` \ (expr', lie) ->
 313     returnTc (HsSCC lbl expr', lie)
 314
 315 tcMonoExpr (HsLet binds expr) res_ty
 316   = tcBindsAndThen
 317         combiner
 318         binds                   -- Bindings to check
 319         tc_expr         `thenTc` \ (expr', lie) ->
 320     returnTc (expr', lie)
 321   where
 322     tc_expr = tcMonoExpr expr res_ty `thenTc` \ (expr', lie) ->
 323               returnTc (expr', lie)
 324     combiner is_rec bind expr = HsLet (mkMonoBind bind [] is_rec) expr
 325
 326 tcMonoExpr in_expr@(HsCase scrut matches src_loc) res_ty
 327   = tcAddSrcLoc src_loc                 $
 328     tcAddErrCtxt (caseCtxt in_expr)     $
 329
 330         -- Typecheck the case alternatives first.
 331         -- The case patterns tend to give good type info to use
 332         -- when typechecking the scrutinee.  For example
 333         --      case (map f) of
 334         --        (x:xs) -> ...
 335         -- will report that map is applied to too few arguments
 336         --
 337         -- Not only that, but it's better to check the matches on their
 338         -- own, so that we get the expected results for scoped type variables.
 339         --      f x = case x of
 340         --              (p::a, q::b) -> (q,p)
 341         -- The above should work: the match (p,q) -> (q,p) is polymorphic as
 342         -- claimed by the pattern signatures.  But if we typechecked the
 343         -- match with x in scope and x's type as the expected type, we'd be hosed.
 344
 345     tcMatchesCase matches res_ty        `thenTc`    \ (scrut_ty, matches', lie2) ->
 346
 347     tcAddErrCtxt (caseScrutCtxt scrut)  (
 348       tcMonoExpr scrut scrut_ty
 349     )                                   `thenTc`    \ (scrut',lie1) ->
 350
 351     returnTc (HsCase scrut' matches' src_loc, plusLIE lie1 lie2)
 352
 353 tcMonoExpr (HsIf pred b1 b2 src_loc) res_ty
 354   = tcAddSrcLoc src_loc $
 355     tcAddErrCtxt (predCtxt pred) (
 356     tcMonoExpr pred boolTy      )       `thenTc`    \ (pred',lie1) ->
 357
 358     tcMonoExpr b1 res_ty                `thenTc`    \ (b1',lie2) ->
 359     tcMonoExpr b2 res_ty                `thenTc`    \ (b2',lie3) ->
 360     returnTc (HsIf pred' b1' b2' src_loc, plusLIE lie1 (plusLIE lie2 lie3))
 361 \end{code}
 362
 363 \begin{code}
 364 tcMonoExpr expr@(HsDo do_or_lc stmts src_loc) res_ty
 365   = tcDoStmts do_or_lc stmts src_loc res_ty
 366 \end{code}
 367
 368 \begin{code}
 369 tcMonoExpr in_expr@(ExplicitList _ exprs) res_ty        -- Non-empty list
 370   = unifyListTy res_ty                        `thenTc` \ elt_ty ->
 371     mapAndUnzipTc (tc_elt elt_ty) exprs       `thenTc` \ (exprs', lies) ->
 372     returnTc (ExplicitList elt_ty exprs', plusLIEs lies)
 373   where
 374     tc_elt elt_ty expr
 375       = tcAddErrCtxt (listCtxt expr) $
 376         tcMonoExpr expr elt_ty
 377
 378 tcMonoExpr (ExplicitTuple exprs boxity) res_ty
 379   = unifyTupleTy boxity (length exprs) res_ty   `thenTc` \ arg_tys ->
 380     mapAndUnzipTc (\ (expr, arg_ty) -> tcMonoExpr expr arg_ty)
 381                (exprs `zip` arg_tys) -- we know they're of equal length.
 382                                                 `thenTc` \ (exprs', lies) ->
 383     returnTc (ExplicitTuple exprs' boxity, plusLIEs lies)
 384
 385 tcMonoExpr expr@(RecordCon con_name rbinds) res_ty
 386   = tcAddErrCtxt (recordConCtxt expr)           $
 387     tcId con_name                       `thenNF_Tc` \ (con_expr, con_lie, con_tau) ->
 388     let
 389         (_, record_ty)   = tcSplitFunTys con_tau
 390         (tycon, ty_args) = tcSplitTyConApp record_ty
 391     in
 392     ASSERT( isAlgTyCon tycon )
 393     unifyTauTy res_ty record_ty          `thenTc_`
 394
 395         -- Check that the record bindings match the constructor
 396         -- con_name is syntactically constrained to be a data constructor
 397     tcLookupDataCon con_name    `thenTc` \ data_con ->
 398     let
 399         bad_fields = badFields rbinds data_con
 400     in
 401     if not (null bad_fields) then
 402         mapNF_Tc (addErrTc . badFieldCon con_name) bad_fields   `thenNF_Tc_`
 403         failTc  -- Fail now, because tcRecordBinds will crash on a bad field
 404     else
 405
 406         -- Typecheck the record bindings
 407     tcRecordBinds tycon ty_args rbinds          `thenTc` \ (rbinds', rbinds_lie) ->
 408
 409     let
 410       (missing_s_fields, missing_fields) = missingFields rbinds data_con
 411     in
 412     checkTcM (null missing_s_fields)
 413         (mapNF_Tc (addErrTc . missingStrictFieldCon con_name) missing_s_fields `thenNF_Tc_`
 414          returnNF_Tc ())  `thenNF_Tc_`
 415     doptsTc Opt_WarnMissingFields `thenNF_Tc` \ warn ->
 416     checkTcM (not (warn && not (null missing_fields)))
 417         (mapNF_Tc ((warnTc True) . missingFieldCon con_name) missing_fields `thenNF_Tc_`
 418          returnNF_Tc ())  `thenNF_Tc_`
 419
 420     returnTc (RecordConOut data_con con_expr rbinds', con_lie `plusLIE` rbinds_lie)
 421
 422 -- The main complication with RecordUpd is that we need to explicitly
 423 -- handle the *non-updated* fields.  Consider:
 424 --
 425 --      data T a b = MkT1 { fa :: a, fb :: b }
 426 --                 | MkT2 { fa :: a, fc :: Int -> Int }
 427 --                 | MkT3 { fd :: a }
 428 --
 429 --      upd :: T a b -> c -> T a c
 430 --      upd t x = t { fb = x}
 431 --
 432 -- The type signature on upd is correct (i.e. the result should not be (T a b))
 433 -- because upd should be equivalent to:
 434 --
 435 --      upd t x = case t of
 436 --                      MkT1 p q -> MkT1 p x
 437 --                      MkT2 a b -> MkT2 p b
 438 --                      MkT3 d   -> error ...
 439 --
 440 -- So we need to give a completely fresh type to the result record,
 441 -- and then constrain it by the fields that are *not* updated ("p" above).
 442 --
 443 -- Note that because MkT3 doesn't contain all the fields being updated,
 444 -- its RHS is simply an error, so it doesn't impose any type constraints
 445 --
 446 -- All this is done in STEP 4 below.
 447
 448 tcMonoExpr expr@(RecordUpd record_expr rbinds) res_ty
 449   = tcAddErrCtxt (recordUpdCtxt expr)           $
 450
 451         -- STEP 0
 452         -- Check that the field names are really field names
 453     ASSERT( not (null rbinds) )
 454     let
 455         field_names = [field_name | (field_name, _, _) <- rbinds]
 456     in
 457     mapNF_Tc tcLookupGlobal_maybe field_names           `thenNF_Tc` \ maybe_sel_ids ->
 458     let
 459         bad_guys = [ addErrTc (notSelector field_name)
 460                    | (field_name, maybe_sel_id) <- field_names `zip` maybe_sel_ids,
 461                       case maybe_sel_id of
 462                         Just (AnId sel_id) -> not (isRecordSelector sel_id)
 463                         other              -> True
 464                    ]
 465     in
 466     checkTcM (null bad_guys) (listNF_Tc bad_guys `thenNF_Tc_` failTc)   `thenTc_`
 467
 468         -- STEP 1
 469         -- Figure out the tycon and data cons from the first field name
 470     let
 471                 -- It's OK to use the non-tc splitters here (for a selector)
 472         (Just (AnId sel_id) : _)    = maybe_sel_ids
 473         (_, _, tau)                 = tcSplitSigmaTy (idType sel_id)    -- Selectors can be overloaded
 474                                                                         -- when the data type has a context
 475         data_ty                     = tcFunArgTy tau                    -- Must succeed since sel_id is a selector
 476         tycon                       = tcTyConAppTyCon data_ty
 477         data_cons                   = tyConDataCons tycon
 478         (con_tyvars, _, _, _, _, _) = dataConSig (head data_cons)
 479     in
 480     tcInstTyVars con_tyvars                     `thenNF_Tc` \ (_, result_inst_tys, _) ->
 481
 482         -- STEP 2
 483         -- Check that at least one constructor has all the named fields
 484         -- i.e. has an empty set of bad fields returned by badFields
 485     checkTc (any (null . badFields rbinds) data_cons)
 486             (badFieldsUpd rbinds)               `thenTc_`
 487
 488         -- STEP 3
 489         -- Typecheck the update bindings.
 490         -- (Do this after checking for bad fields in case there's a field that
 491         --  doesn't match the constructor.)
 492     let
 493         result_record_ty = mkTyConApp tycon result_inst_tys
 494     in
 495     unifyTauTy res_ty result_record_ty          `thenTc_`
 496     tcRecordBinds tycon result_inst_tys rbinds  `thenTc` \ (rbinds', rbinds_lie) ->
 497
 498         -- STEP 4
 499         -- Use the un-updated fields to find a vector of booleans saying
 500         -- which type arguments must be the same in updatee and result.
 501         --
 502         -- WARNING: this code assumes that all data_cons in a common tycon
 503         -- have FieldLabels abstracted over the same tyvars.
 504     let
 505         upd_field_lbls      = [recordSelectorFieldLabel sel_id | (sel_id, _, _) <- rbinds']
 506         con_field_lbls_s    = map dataConFieldLabels data_cons
 507
 508                 -- A constructor is only relevant to this process if
 509                 -- it contains all the fields that are being updated
 510         relevant_field_lbls_s      = filter is_relevant con_field_lbls_s
 511         is_relevant con_field_lbls = all (`elem` con_field_lbls) upd_field_lbls
 512
 513         non_upd_field_lbls  = concat relevant_field_lbls_s `minusList` upd_field_lbls
 514         common_tyvars       = tyVarsOfTypes (map fieldLabelType non_upd_field_lbls)
 515
 516         mk_inst_ty (tyvar, result_inst_ty)
 517           | tyvar `elemVarSet` common_tyvars = returnNF_Tc result_inst_ty       -- Same as result type
 518           | otherwise                               = newTyVarTy liftedTypeKind -- Fresh type
 519     in
 520     mapNF_Tc mk_inst_ty (zip con_tyvars result_inst_tys)        `thenNF_Tc` \ inst_tys ->
 521
 522         -- STEP 5
 523         -- Typecheck the expression to be updated
 524     let
 525         record_ty = mkTyConApp tycon inst_tys
 526     in
 527     tcMonoExpr record_expr record_ty                    `thenTc`    \ (record_expr', record_lie) ->
 528
 529         -- STEP 6
 530         -- Figure out the LIE we need.  We have to generate some
 531         -- dictionaries for the data type context, since we are going to
 532         -- do some construction.
 533         --
 534         -- What dictionaries do we need?  For the moment we assume that all
 535         -- data constructors have the same context, and grab it from the first
 536         -- constructor.  If they have varying contexts then we'd have to
 537         -- union the ones that could participate in the update.
 538     let
 539         (tyvars, theta, _, _, _, _) = dataConSig (head data_cons)
 540         inst_env = mkTopTyVarSubst tyvars result_inst_tys
 541         theta'   = substTheta inst_env theta
 542     in
 543     newDicts RecordUpdOrigin theta'     `thenNF_Tc` \ dicts ->
 544
 545         -- Phew!
 546     returnTc (RecordUpdOut record_expr' record_ty result_record_ty (map instToId dicts) rbinds',
 547               mkLIE dicts `plusLIE` record_lie `plusLIE` rbinds_lie)
 548
 549 tcMonoExpr (ArithSeqIn seq@(From expr)) res_ty
 550   = unifyListTy res_ty                          `thenTc` \ elt_ty ->
 551     tcMonoExpr expr elt_ty                      `thenTc` \ (expr', lie1) ->
 552
 553     tcLookupGlobalId enumFromName               `thenNF_Tc` \ sel_id ->
 554     newMethod (ArithSeqOrigin seq)
 555               sel_id [elt_ty]                   `thenNF_Tc` \ enum_from ->
 556
 557     returnTc (ArithSeqOut (HsVar (instToId enum_from)) (From expr'),
 558               lie1 `plusLIE` unitLIE enum_from)
 559
 560 tcMonoExpr in_expr@(ArithSeqIn seq@(FromThen expr1 expr2)) res_ty
 561   = tcAddErrCtxt (arithSeqCtxt in_expr) $
 562     unifyListTy  res_ty                                 `thenTc`    \ elt_ty ->
 563     tcMonoExpr expr1 elt_ty                             `thenTc`    \ (expr1',lie1) ->
 564     tcMonoExpr expr2 elt_ty                             `thenTc`    \ (expr2',lie2) ->
 565     tcLookupGlobalId enumFromThenName                   `thenNF_Tc` \ sel_id ->
 566     newMethod (ArithSeqOrigin seq) sel_id [elt_ty]      `thenNF_Tc` \ enum_from_then ->
 567
 568     returnTc (ArithSeqOut (HsVar (instToId enum_from_then))
 569                           (FromThen expr1' expr2'),
 570               lie1 `plusLIE` lie2 `plusLIE` unitLIE enum_from_then)
 571
 572 tcMonoExpr in_expr@(ArithSeqIn seq@(FromTo expr1 expr2)) res_ty
 573   = tcAddErrCtxt (arithSeqCtxt in_expr) $
 574     unifyListTy  res_ty                                 `thenTc`    \ elt_ty ->
 575     tcMonoExpr expr1 elt_ty                             `thenTc`    \ (expr1',lie1) ->
 576     tcMonoExpr expr2 elt_ty                             `thenTc`    \ (expr2',lie2) ->
 577     tcLookupGlobalId enumFromToName                     `thenNF_Tc` \ sel_id ->
 578     newMethod (ArithSeqOrigin seq) sel_id [elt_ty]      `thenNF_Tc` \ enum_from_to ->
 579
 580     returnTc (ArithSeqOut (HsVar (instToId enum_from_to))
 581                           (FromTo expr1' expr2'),
 582               lie1 `plusLIE` lie2 `plusLIE` unitLIE enum_from_to)
 583
 584 tcMonoExpr in_expr@(ArithSeqIn seq@(FromThenTo expr1 expr2 expr3)) res_ty
 585   = tcAddErrCtxt  (arithSeqCtxt in_expr) $
 586     unifyListTy  res_ty                                 `thenTc`    \ elt_ty ->
 587     tcMonoExpr expr1 elt_ty                             `thenTc`    \ (expr1',lie1) ->
 588     tcMonoExpr expr2 elt_ty                             `thenTc`    \ (expr2',lie2) ->
 589     tcMonoExpr expr3 elt_ty                             `thenTc`    \ (expr3',lie3) ->
 590     tcLookupGlobalId enumFromThenToName                 `thenNF_Tc` \ sel_id ->
 591     newMethod (ArithSeqOrigin seq) sel_id [elt_ty]      `thenNF_Tc` \ eft ->
 592
 593     returnTc (ArithSeqOut (HsVar (instToId eft))
 594                           (FromThenTo expr1' expr2' expr3'),
 595               lie1 `plusLIE` lie2 `plusLIE` lie3 `plusLIE` unitLIE eft)
 596 \end{code}
 597
 598 %************************************************************************
 599 %*                                                                      *
 600 \subsection{Expressions type signatures}
 601 %*                                                                      *
 602 %************************************************************************
 603
 604 \begin{code}
 605 tcMonoExpr in_expr@(ExprWithTySig expr poly_ty) res_ty
 606  = tcHsSigType ExprSigCtxt poly_ty      `thenTc` \ sig_tc_ty ->
 607
 608    tcAddErrCtxt (exprSigCtxt in_expr)   $
 609    if not (isQualifiedTy sig_tc_ty) then
 610         -- Easy case
 611         unifyTauTy sig_tc_ty res_ty     `thenTc_`
 612         tcMonoExpr expr sig_tc_ty
 613
 614    else -- Signature is polymorphic
 615         tcPolyExpr expr sig_tc_ty               `thenTc` \ (_, _, expr, expr_ty, lie) ->
 616
 617             -- Now match the signature type with res_ty.
 618             -- We must not do this earlier, because res_ty might well
 619             -- mention variables free in the environment, and we'd get
 620             -- bogus complaints about not being able to for-all the
 621             -- sig_tyvars
 622         unifyTauTy res_ty expr_ty                       `thenTc_`
 623
 624             -- If everything is ok, return the stuff unchanged, except for
 625             -- the effect of any substutions etc.  We simply discard the
 626             -- result of the tcSimplifyCheck (inside tcPolyExpr), except for any default
 627             -- resolution it may have done, which is recorded in the
 628             -- substitution.
 629         returnTc (expr, lie)
 630 \end{code}
 631
 632 Implicit Parameter bindings.
 633
 634 \begin{code}
 635 tcMonoExpr (HsWith expr binds) res_ty
 636   = tcMonoExpr expr res_ty                      `thenTc` \ (expr', expr_lie) ->
 637     mapAndUnzipTc tcIPBind binds                `thenTc` \ (pairs, bind_lies) ->
 638
 639         -- If the binding binds ?x = E, we  must now
 640         -- discharge any ?x constraints in expr_lie
 641     tcSimplifyIPs (map fst pairs) expr_lie      `thenTc` \ (expr_lie', dict_binds) ->
 642     let
 643         binds' = [(instToId ip, rhs) | (ip,rhs) <- pairs]
 644         expr'' = HsLet (mkMonoBind dict_binds [] Recursive) expr'
 645     in
 646     returnTc (HsWith expr'' binds', expr_lie' `plusLIE` plusLIEs bind_lies)
 647
 648 tcIPBind (name, expr)
 649   = newTyVarTy openTypeKind             `thenTc` \ ty ->
 650     tcGetSrcLoc                         `thenTc` \ loc ->
 651     newIPDict (IPBind name) name ty     `thenNF_Tc` \ ip ->
 652     tcMonoExpr expr ty                  `thenTc` \ (expr', lie) ->
 653     returnTc ((ip, expr'), lie)
 654 \end{code}
 655
 656 %************************************************************************
 657 %*                                                                      *
 658 \subsection{@tcApp@ typchecks an application}
 659 %*                                                                      *
 660 %************************************************************************
 661
 662 \begin{code}
 663
 664 tcApp :: RenamedHsExpr -> [RenamedHsExpr]       -- Function and args
 665       -> TcType                                 -- Expected result type of application
 666       -> TcM (TcExpr, [TcExpr],         -- Translated fun and args
 667                 LIE)
 668
 669 tcApp fun args res_ty
 670   =     -- First type-check the function
 671     tcExpr_id fun                               `thenTc` \ (fun', lie_fun, fun_ty) ->
 672
 673     tcAddErrCtxt (wrongArgsCtxt "too many" fun args) (
 674         split_fun_ty fun_ty (length args)
 675     )                                           `thenTc` \ (expected_arg_tys, actual_result_ty) ->
 676
 677         -- Unify with expected result before type-checking the args
 678         -- This is when we might detect a too-few args situation
 679     tcAddErrCtxtM (checkArgsCtxt fun args res_ty actual_result_ty) (
 680        unifyTauTy res_ty actual_result_ty
 681     )                                                   `thenTc_`
 682
 683         -- Now typecheck the args
 684     mapAndUnzipTc (tcArg fun)
 685           (zip3 args expected_arg_tys [1..])    `thenTc` \ (args', lie_args_s) ->
 686
 687     -- Check that the result type doesn't have any nested for-alls.
 688     -- For example, a "build" on its own is no good; it must be applied to something.
 689     checkTc (isTauTy actual_result_ty)
 690             (lurkingRank2Err fun actual_result_ty)      `thenTc_`
 691
 692     returnTc (fun', args', lie_fun `plusLIE` plusLIEs lie_args_s)
 693
 694
 695 -- If an error happens we try to figure out whether the
 696 -- function has been given too many or too few arguments,
 697 -- and say so
 698 checkArgsCtxt fun args expected_res_ty actual_res_ty tidy_env
 699   = zonkTcType expected_res_ty    `thenNF_Tc` \ exp_ty' ->
 700     zonkTcType actual_res_ty      `thenNF_Tc` \ act_ty' ->
 701     let
 702       (env1, exp_ty'') = tidyOpenType tidy_env exp_ty'
 703       (env2, act_ty'') = tidyOpenType env1     act_ty'
 704       (exp_args, _)    = tcSplitFunTys exp_ty''
 705       (act_args, _)    = tcSplitFunTys act_ty''
 706
 707       message | length exp_args < length act_args = wrongArgsCtxt "too few" fun args
 708               | length exp_args > length act_args = wrongArgsCtxt "too many" fun args
 709               | otherwise                         = appCtxt fun args
 710     in
 711     returnNF_Tc (env2, message)
 712
 713
 714 split_fun_ty :: TcType          -- The type of the function
 715              -> Int                     -- Number of arguments
 716              -> TcM ([TcType],  -- Function argument types
 717                        TcType)  -- Function result types
 718
 719 split_fun_ty fun_ty 0
 720   = returnTc ([], fun_ty)
 721
 722 split_fun_ty fun_ty n
 723   =     -- Expect the function to have type A->B
 724     unifyFunTy fun_ty           `thenTc` \ (arg_ty, res_ty) ->
 725     split_fun_ty res_ty (n-1)   `thenTc` \ (arg_tys, final_res_ty) ->
 726     returnTc (arg_ty:arg_tys, final_res_ty)
 727 \end{code}
 728
 729 \begin{code}
 730 tcArg :: RenamedHsExpr                  -- The function (for error messages)
 731       -> (RenamedHsExpr, TcType, Int)   -- Actual argument and expected arg type
 732       -> TcM (TcExpr, LIE)      -- Resulting argument and LIE
 733
 734 tcArg the_fun (arg, expected_arg_ty, arg_no)
 735   = tcAddErrCtxt (funAppCtxt the_fun arg arg_no) $
 736     tcExpr arg expected_arg_ty
 737 \end{code}
 738
 739
 740 %************************************************************************
 741 %*                                                                      *
 742 \subsection{@tcId@ typchecks an identifier occurrence}
 743 %*                                                                      *
 744 %************************************************************************
 745
 746 \begin{code}
 747 tcId :: Name -> NF_TcM (TcExpr, LIE, TcType)
 748 tcId name       -- Look up the Id and instantiate its type
 749   = tcLookupId name                     `thenNF_Tc` \ id ->
 750     tcInstId id
 751 \end{code}
 752
 753 Typecheck expression which in most cases will be an Id.
 754
 755 \begin{code}
 756 tcExpr_id :: RenamedHsExpr -> TcM (TcExpr, LIE, TcType)
 757 tcExpr_id (HsVar name) = tcId name
 758 tcExpr_id expr         = newTyVarTy openTypeKind        `thenNF_Tc` \ id_ty ->
 759                          tcMonoExpr expr id_ty  `thenTc`    \ (expr', lie_id) ->
 760                          returnTc (expr', lie_id, id_ty)
 761 \end{code}
 762
 763
 764 %************************************************************************
 765 %*                                                                      *
 766 \subsection{@tcDoStmts@ typechecks a {\em list} of do statements}
 767 %*                                                                      *
 768 %************************************************************************
 769
 770 \begin{code}
 771 tcDoStmts do_or_lc stmts src_loc res_ty
 772   =     -- get the Monad and MonadZero classes
 773         -- create type consisting of a fresh monad tyvar
 774     ASSERT( not (null stmts) )
 775     tcAddSrcLoc src_loc $
 776
 777         -- If it's a comprehension we're dealing with,
 778         -- force it to be a list comprehension.
 779         -- (as of Haskell 98, monad comprehensions are no more.)
 780     (case do_or_lc of
 781        ListComp -> unifyListTy res_ty                   `thenTc` \ elt_ty ->
 782                    returnNF_Tc (mkTyConTy listTyCon, (mkListTy, elt_ty))
 783
 784        _        -> newTyVarTy (mkArrowKind liftedTypeKind liftedTypeKind)       `thenNF_Tc` \ m_ty ->
 785                    newTyVarTy liftedTypeKind                                    `thenNF_Tc` \ elt_ty ->
 786                    unifyTauTy res_ty (mkAppTy m_ty elt_ty)                      `thenTc_`
 787                    returnNF_Tc (m_ty, (mkAppTy m_ty, elt_ty))
 788     )                                                   `thenNF_Tc` \ (tc_ty, m_ty) ->
 789
 790     tcStmts (DoCtxt do_or_lc) m_ty stmts                `thenTc`   \ (stmts', stmts_lie) ->
 791
 792         -- Build the then and zero methods in case we need them
 793         -- It's important that "then" and "return" appear just once in the final LIE,
 794         -- not only for typechecker efficiency, but also because otherwise during
 795         -- simplification we end up with silly stuff like
 796         --      then = case d of (t,r) -> t
 797         --      then = then
 798         -- where the second "then" sees that it already exists in the "available" stuff.
 799         --
 800     tcLookupGlobalId returnMName                `thenNF_Tc` \ return_sel_id ->
 801     tcLookupGlobalId thenMName                  `thenNF_Tc` \ then_sel_id ->
 802     tcLookupGlobalId failMName                  `thenNF_Tc` \ fail_sel_id ->
 803     newMethod DoOrigin return_sel_id [tc_ty]    `thenNF_Tc` \ return_inst ->
 804     newMethod DoOrigin then_sel_id   [tc_ty]    `thenNF_Tc` \ then_inst ->
 805     newMethod DoOrigin fail_sel_id   [tc_ty]    `thenNF_Tc` \ fail_inst ->
 806     let
 807         monad_lie = mkLIE [return_inst, then_inst, fail_inst]
 808     in
 809     returnTc (HsDoOut do_or_lc stmts'
 810                       (instToId return_inst) (instToId then_inst) (instToId fail_inst)
 811                       res_ty src_loc,
 812               stmts_lie `plusLIE` monad_lie)
 813 \end{code}
 814
 815
 816 %************************************************************************
 817 %*                                                                      *
 818 \subsection{Record bindings}
 819 %*                                                                      *
 820 %************************************************************************
 821
 822 Game plan for record bindings
 823 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 824 1. Find the TyCon for the bindings, from the first field label.
 825
 826 2. Instantiate its tyvars and unify (T a1 .. an) with expected_ty.
 827
 828 For each binding field = value
 829
 830 3. Instantiate the field type (from the field label) using the type
 831    envt from step 2.
 832
 833 4  Type check the value using tcArg, passing the field type as
 834    the expected argument type.
 835
 836 This extends OK when the field types are universally quantified.
 837
 838
 839 \begin{code}
 840 tcRecordBinds
 841         :: TyCon                -- Type constructor for the record
 842         -> [TcType]             -- Args of this type constructor
 843         -> RenamedRecordBinds
 844         -> TcM (TcRecordBinds, LIE)
 845
 846 tcRecordBinds tycon ty_args rbinds
 847   = mapAndUnzipTc do_bind rbinds        `thenTc` \ (rbinds', lies) ->
 848     returnTc (rbinds', plusLIEs lies)
 849   where
 850     tenv = mkTopTyVarSubst (tyConTyVars tycon) ty_args
 851
 852     do_bind (field_lbl_name, rhs, pun_flag)
 853       = tcLookupGlobalId field_lbl_name         `thenNF_Tc` \ sel_id ->
 854         let
 855             field_lbl = recordSelectorFieldLabel sel_id
 856             field_ty  = substTy tenv (fieldLabelType field_lbl)
 857         in
 858         ASSERT( isRecordSelector sel_id )
 859                 -- This lookup and assertion will surely succeed, because
 860                 -- we check that the fields are indeed record selectors
 861                 -- before calling tcRecordBinds
 862         ASSERT2( fieldLabelTyCon field_lbl == tycon, ppr field_lbl )
 863                 -- The caller of tcRecordBinds has already checked
 864                 -- that all the fields come from the same type
 865
 866         tcPolyExpr rhs field_ty         `thenTc` \ (rhs', lie, _, _, _) ->
 867
 868         returnTc ((sel_id, rhs', pun_flag), lie)
 869
 870 badFields rbinds data_con
 871   = [field_name | (field_name, _, _) <- rbinds,
 872                   not (field_name `elem` field_names)
 873     ]
 874   where
 875     field_names = map fieldLabelName (dataConFieldLabels data_con)
 876
 877 missingFields rbinds data_con
 878   | null field_labels = ([], [])        -- Not declared as a record;
 879                                         -- But C{} is still valid
 880   | otherwise
 881   = (missing_strict_fields, other_missing_fields)
 882   where
 883     missing_strict_fields
 884         = [ fl | (fl, str) <- field_info,
 885                  isMarkedStrict str,
 886                  not (fieldLabelName fl `elem` field_names_used)
 887           ]
 888     other_missing_fields
 889         = [ fl | (fl, str) <- field_info,
 890                  not (isMarkedStrict str),
 891                  not (fieldLabelName fl `elem` field_names_used)
 892           ]
 893
 894     field_names_used = [ field_name | (field_name, _, _) <- rbinds ]
 895     field_labels     = dataConFieldLabels data_con
 896
 897     field_info = zipEqual "missingFields"
 898                           field_labels
 899                           (drop (length ex_theta) (dataConStrictMarks data_con))
 900         -- The 'drop' is because dataConStrictMarks
 901         -- includes the existential dictionaries
 902     (_, _, _, ex_theta, _, _) = dataConSig data_con
 903 \end{code}
 904
 905 %************************************************************************
 906 %*                                                                      *
 907 \subsection{@tcMonoExprs@ typechecks a {\em list} of expressions}
 908 %*                                                                      *
 909 %************************************************************************
 910
 911 \begin{code}
 912 tcMonoExprs :: [RenamedHsExpr] -> [TcType] -> TcM ([TcExpr], LIE)
 913
 914 tcMonoExprs [] [] = returnTc ([], emptyLIE)
 915 tcMonoExprs (expr:exprs) (ty:tys)
 916  = tcMonoExpr  expr  ty         `thenTc` \ (expr',  lie1) ->
 917    tcMonoExprs exprs tys                `thenTc` \ (exprs', lie2) ->
 918    returnTc (expr':exprs', lie1 `plusLIE` lie2)
 919 \end{code}
 920
 921
 922 %************************************************************************
 923 %*                                                                      *
 924 \subsection{Literals}
 925 %*                                                                      *
 926 %************************************************************************
 927
 928 Overloaded literals.
 929
 930 \begin{code}
 931 tcLit :: HsLit -> TcType -> TcM (TcExpr, LIE)
 932 tcLit (HsLitLit s _) res_ty
 933   = tcLookupClass cCallableClassName                    `thenNF_Tc` \ cCallableClass ->
 934     newDicts (LitLitOrigin (_UNPK_ s))
 935              [mkClassPred cCallableClass [res_ty]]      `thenNF_Tc` \ dicts ->
 936     returnTc (HsLit (HsLitLit s res_ty), mkLIE dicts)
 937
 938 tcLit lit res_ty
 939   = unifyTauTy res_ty (simpleHsLitTy lit)               `thenTc_`
 940     returnTc (HsLit lit, emptyLIE)
 941 \end{code}
 942
 943
 944 %************************************************************************
 945 %*                                                                      *
 946 \subsection{Errors and contexts}
 947 %*                                                                      *
 948 %************************************************************************
 949
 950 Mini-utils:
 951
 952 Boring and alphabetical:
 953 \begin{code}
 954 arithSeqCtxt expr
 955   = hang (ptext SLIT("In an arithmetic sequence:")) 4 (ppr expr)
 956
 957 caseCtxt expr
 958   = hang (ptext SLIT("In the case expression:")) 4 (ppr expr)
 959
 960 caseScrutCtxt expr
 961   = hang (ptext SLIT("In the scrutinee of a case expression:")) 4 (ppr expr)
 962
 963 exprSigCtxt expr
 964   = hang (ptext SLIT("In an expression with a type signature:"))
 965          4 (ppr expr)
 966
 967 listCtxt expr
 968   = hang (ptext SLIT("In the list element:")) 4 (ppr expr)
 969
 970 predCtxt expr
 971   = hang (ptext SLIT("In the predicate expression:")) 4 (ppr expr)
 972
 973 sectionRAppCtxt expr
 974   = hang (ptext SLIT("In the right section:")) 4 (ppr expr)
 975
 976 sectionLAppCtxt expr
 977   = hang (ptext SLIT("In the left section:")) 4 (ppr expr)
 978
 979 funAppCtxt fun arg arg_no
 980   = hang (hsep [ ptext SLIT("In the"), speakNth arg_no, ptext SLIT("argument of"),
 981                     quotes (ppr fun) <> text ", namely"])
 982          4 (quotes (ppr arg))
 983
 984 wrongArgsCtxt too_many_or_few fun args
 985   = hang (ptext SLIT("Probable cause:") <+> quotes (ppr fun)
 986                     <+> ptext SLIT("is applied to") <+> text too_many_or_few
 987                     <+> ptext SLIT("arguments in the call"))
 988          4 (parens (ppr the_app))
 989   where
 990     the_app = foldl HsApp fun args      -- Used in error messages
 991
 992 appCtxt fun args
 993   = ptext SLIT("In the application") <+> quotes (ppr the_app)
 994   where
 995     the_app = foldl HsApp fun args      -- Used in error messages
 996
 997 lurkingRank2Err fun fun_ty
 998   = hang (hsep [ptext SLIT("Illegal use of"), quotes (ppr fun)])
 999          4 (vcat [ptext SLIT("It is applied to too few arguments"),
1000                   ptext SLIT("so that the result type has for-alls in it:") <+> ppr fun_ty])
1001
1002 badFieldsUpd rbinds
1003   = hang (ptext SLIT("No constructor has all these fields:"))
1004          4 (pprQuotedList fields)
1005   where
1006     fields = [field | (field, _, _) <- rbinds]
1007
1008 recordUpdCtxt expr = ptext SLIT("In the record update:") <+> ppr expr
1009 recordConCtxt expr = ptext SLIT("In the record construction:") <+> ppr expr
1010
1011 notSelector field
1012   = hsep [quotes (ppr field), ptext SLIT("is not a record selector")]
1013
1014 missingStrictFieldCon :: Name -> FieldLabel -> SDoc
1015 missingStrictFieldCon con field
1016   = hsep [ptext SLIT("Constructor") <+> quotes (ppr con),
1017           ptext SLIT("does not have the required strict field"), quotes (ppr field)]
1018
1019 missingFieldCon :: Name -> FieldLabel -> SDoc
1020 missingFieldCon con field
1021   = hsep [ptext SLIT("Field") <+> quotes (ppr field),
1022           ptext SLIT("is not initialised")]
1023 \end{code}