#endif
import HsSyn ( HsExpr(..), LHsExpr, ArithSeqInfo(..), recBindFields,
#endif
import HsSyn ( HsExpr(..), LHsExpr, ArithSeqInfo(..), recBindFields,
- HsMatchContext(..), HsRecordBinds, mkHsCoerce,
- mkHsApp )
+ HsMatchContext(..), HsRecordBinds, mkHsWrap,
+ mkHsApp, mkLHsWrap )
import TcHsSyn ( hsLitType )
import TcRnMonad
import TcUnify ( tcInfer, tcSubExp, tcFunResTy, tcGen, boxyUnify, subFunTys, zapToMonotype, stripBoxyType,
import TcHsSyn ( hsLitType )
import TcRnMonad
import TcUnify ( tcInfer, tcSubExp, tcFunResTy, tcGen, boxyUnify, subFunTys, zapToMonotype, stripBoxyType,
isRecordSelector, isNaughtyRecordSelector,
isDataConId_maybe )
import DataCon ( DataCon, dataConFieldLabels, dataConStrictMarks,
isRecordSelector, isNaughtyRecordSelector,
isDataConId_maybe )
import DataCon ( DataCon, dataConFieldLabels, dataConStrictMarks,
= do { (gen_fn, expr') <- tcGen res_ty emptyVarSet (tcPolyExprNC expr)
-- Note the recursive call to tcPolyExpr, because the
-- type may have multiple layers of for-alls
= do { (gen_fn, expr') <- tcGen res_ty emptyVarSet (tcPolyExprNC expr)
-- Note the recursive call to tcPolyExpr, because the
-- type may have multiple layers of for-alls
; co_fn <- tcSubExp ip_ty res_ty
; (ip', inst) <- newIPDict (IPOccOrigin ip) ip ip_ty
; extendLIE inst
; co_fn <- tcSubExp ip_ty res_ty
; (ip', inst) <- newIPDict (IPOccOrigin ip) ip ip_ty
; extendLIE inst
tcExpr (HsLam match) res_ty
= do { (co_fn, match') <- tcMatchLambda match res_ty
tcExpr (HsLam match) res_ty
= do { (co_fn, match') <- tcMatchLambda match res_ty
tcExpr in_expr@(ExprWithTySig expr sig_ty) res_ty
= do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
; expr' <- tcPolyExpr expr sig_tc_ty
; co_fn <- tcSubExp sig_tc_ty res_ty
tcExpr in_expr@(ExprWithTySig expr sig_ty) res_ty
= do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
; expr' <- tcPolyExpr expr sig_tc_ty
; co_fn <- tcSubExp sig_tc_ty res_ty
tcExpr in_expr@(SectionR lop@(L loc op) arg2) res_ty
= do { (co_fn, (op', arg2')) <- subFunTys doc 1 res_ty $ \ [arg1_ty'] res_ty' ->
tcApp op 2 (tc_args arg1_ty') res_ty'
tcExpr in_expr@(SectionR lop@(L loc op) arg2) res_ty
= do { (co_fn, (op', arg2')) <- subFunTys doc 1 res_ty $ \ [arg1_ty'] res_ty' ->
tcApp op 2 (tc_args arg1_ty') res_ty'
-- tcFun work nicely for OpApp and Sections too
; fun' <- instFun orig fun res_subst tv_theta_prs
; co_fn' <- wrapFunResCoercion fun_arg_tys' co_fn
-- tcFun work nicely for OpApp and Sections too
; fun' <- instFun orig fun res_subst tv_theta_prs
; co_fn' <- wrapFunResCoercion fun_arg_tys' co_fn
go _ fun ((tys, theta) : prs)
= do { co_fn <- instCall orig tys theta
go _ fun ((tys, theta) : prs)
= do { co_fn <- instCall orig tys theta
-> do { thLocalId orig id ty lvl
; case mb_co of
Nothing -> return (HsVar id, ty) -- Wobbly, or no free vars
-> do { thLocalId orig id ty lvl
; case mb_co of
Nothing -> return (HsVar id, ty) -- Wobbly, or no free vars