-\subsection{@tcQuals@ typechecks list-comprehension qualifiers}
-%* *
-%************************************************************************
-
-\begin{code}
-tcListComp expr []
- = tcExpr expr `thenTc` \ (expr', lie, ty) ->
- returnTc ((expr',[]), lie, mkListTy ty)
-
-tcListComp expr (qual@(FilterQual filter) : quals)
- = tcAddErrCtxt (qualCtxt qual) (
- tcExpr filter `thenTc` \ (filter', filter_lie, filter_ty) ->
- unifyTauTy boolTy filter_ty `thenTc_`
- returnTc (FilterQual filter', filter_lie)
- ) `thenTc` \ (qual', qual_lie) ->
-
- tcListComp expr quals `thenTc` \ ((expr',quals'), rest_lie, res_ty) ->
-
- returnTc ((expr', qual' : quals'),
- qual_lie `plusLIE` rest_lie,
- res_ty)
-
-tcListComp expr (qual@(GeneratorQual pat rhs) : quals)
- = newMonoIds binder_names mkBoxedTypeKind (\ ids ->
-
- tcAddErrCtxt (qualCtxt qual) (
- tcPat pat `thenTc` \ (pat', lie_pat, pat_ty) ->
- tcExpr rhs `thenTc` \ (rhs', lie_rhs, rhs_ty) ->
- -- NB: the environment has been extended with the new binders
- -- which the rhs can't "see", but the renamer should have made
- -- sure that everything is distinct by now, so there's no problem.
- -- Putting the tcExpr before the newMonoIds messes up the nesting
- -- of error contexts, so I didn't bother
-
- unifyTauTy (mkListTy pat_ty) rhs_ty `thenTc_`
- returnTc (GeneratorQual pat' rhs',
- lie_pat `plusLIE` lie_rhs)
- ) `thenTc` \ (qual', lie_qual) ->
-
- tcListComp expr quals `thenTc` \ ((expr',quals'), lie_rest, res_ty) ->
-
- returnTc ((expr', qual' : quals'),
- lie_qual `plusLIE` lie_rest,
- res_ty)
- )
- where
- binder_names = collectPatBinders pat
-
-tcListComp expr (LetQual binds : quals)
- = tcBindsAndThen -- No error context, but a binding group is
- combine -- rather a large thing for an error context anyway
- binds
- (tcListComp expr quals)
- where
- combine binds' (expr',quals') = (expr', LetQual binds' : quals')
-\end{code}
-
-
-%************************************************************************
-%* *