+ (case [ty | (f,ty) <- field_tys, f == field_label] of
+
+ -- No matching field; chances are this field label comes from some
+ -- other record type (or maybe none). As well as reporting an
+ -- error we still want to typecheck the pattern, principally to
+ -- make sure that all the variables it binds are put into the
+ -- environment, else the type checker crashes later:
+ -- f (R { foo = (a,b) }) = a+b
+ -- If foo isn't one of R's fields, we don't want to crash when
+ -- typechecking the "a+b".
+ [] -> addErrTc (badFieldCon data_con field_label) `thenM_`
+ newTyVarTy liftedTypeKind `thenM` \ bogus_ty ->
+ returnM (error "Bogus selector Id", bogus_ty)
+
+ -- The normal case, when the field comes from the right constructor
+ (pat_ty : extras) ->
+ ASSERT( null extras )
+ tcLookupId field_label `thenM` \ sel_id ->
+ returnM (sel_id, pat_ty)
+ ) `thenM` \ (sel_id, pat_ty) ->
+
+ tcPat tc_bndr rhs_pat (Check pat_ty) `thenM` \ (rhs_pat', tvs2, ids2, lie_avail2) ->
+
+ returnM ((sel_id, rhs_pat') : rpats',
+ tvs1 `unionBags` tvs2,
+ ids1 `unionBags` ids2,
+ lie_avail1 ++ lie_avail2)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Subsumption}
+%* *
+%************************************************************************
+
+Example:
+ f :: (forall a. a->a) -> Int -> Int
+ f (g::Int->Int) y = g y
+This is ok: the type signature allows fewer callers than
+the (more general) signature f :: (Int->Int) -> Int -> Int
+I.e. (forall a. a->a) <= Int -> Int
+We end up translating this to:
+ f = \g' :: (forall a. a->a). let g = g' Int in g' y
+
+tcSubPat does the work
+ sig_ty is the signature on the pattern itself
+ (Int->Int in the example)
+ expected_ty is the type passed inwards from the context
+ (forall a. a->a in the example)
+
+\begin{code}
+tcSubPat :: TcSigmaType -> Expected TcSigmaType -> TcM PatCoFn
+
+tcSubPat sig_ty exp_ty
+ = tcSubOff sig_ty exp_ty `thenM` \ co_fn ->
+ -- co_fn is a coercion on *expressions*, and we
+ -- need to make a coercion on *patterns*
+ if isIdCoercion co_fn then
+ returnM idCoercion
+ else
+ newUnique `thenM` \ uniq ->
+ readExpectedType exp_ty `thenM` \ exp_ty' ->
+ let
+ arg_id = mkSysLocal FSLIT("sub") uniq exp_ty'
+ the_fn = DictLam [arg_id] (co_fn <$> HsVar arg_id)
+ pat_co_fn p = SigPatOut p exp_ty' the_fn
+ in
+ returnM (mkCoercion pat_co_fn)