tcPolyExprNC expr res_ty
= do { traceTc "tcPolyExprNC" (ppr res_ty)
- ; (gen_fn, expr') <- tcGen (GenSkol res_ty) emptyVarSet res_ty $ \ _ rho ->
+ ; (gen_fn, expr') <- tcGen (GenSkol res_ty) res_ty $ \ _ rho ->
tcMonoExprNC expr rho
; return (mkLHsWrap gen_fn expr') }
-- Remember to extend the lexical type-variable environment
; (gen_fn, expr')
- <- tcGen (SigSkol ExprSigCtxt) emptyVarSet sig_tc_ty $ \ skol_tvs res_ty ->
+ <- tcGen (SigSkol ExprSigCtxt) sig_tc_ty $ \ skol_tvs res_ty ->
tcExtendTyVarEnv2 (hsExplicitTvs sig_ty `zip` mkTyVarTys skol_tvs) $
-- See Note [More instantiated than scoped] in TcBinds
tcMonoExprNC expr res_ty
tcExpr (SectionL arg1 op) res_ty
= do { (op', op_ty) <- tcInferFun op
; dflags <- getDOpts -- Note [Left sections]
- ; let n_reqd_args | dopt Opt_PostfixOperators dflags = 1
+ ; let n_reqd_args | xopt Opt_PostfixOperators dflags = 1
| otherwise = 2
; (co_fn, (arg1_ty:arg_tys), op_res_ty) <- unifyOpFunTys op n_reqd_args op_ty
match_ctxt = MC { mc_what = CaseAlt,
mc_body = tcBody }
-tcExpr (HsIf pred b1 b2) res_ty
- = do { pred' <- tcMonoExpr pred boolTy
- ; b1' <- tcMonoExpr b1 res_ty
- ; b2' <- tcMonoExpr b2 res_ty
- ; return (HsIf pred' b1' b2') }
+tcExpr (HsIf Nothing pred b1 b2) res_ty -- Ordinary 'if'
+ = do { pred' <- tcMonoExpr pred boolTy
+ ; b1' <- tcMonoExpr b1 res_ty
+ ; b2' <- tcMonoExpr b2 res_ty
+ ; return (HsIf Nothing pred' b1' b2') }
+
+tcExpr (HsIf (Just fun) pred b1 b2) res_ty -- Note [Rebindable syntax for if]
+ = do { pred_ty <- newFlexiTyVarTy openTypeKind
+ ; b1_ty <- newFlexiTyVarTy openTypeKind
+ ; b2_ty <- newFlexiTyVarTy openTypeKind
+ ; let if_ty = mkFunTys [pred_ty, b1_ty, b2_ty] res_ty
+ ; fun' <- tcSyntaxOp IfOrigin fun if_ty
+ ; pred' <- tcMonoExpr pred pred_ty
+ ; b1' <- tcMonoExpr b1 b1_ty
+ ; b2' <- tcMonoExpr b2 b2_ty
+ -- Fundamentally we are just typing (ifThenElse e1 e2 e3)
+ -- so maybe we should use the code for function applications
+ -- (which would allow ifThenElse to be higher rank).
+ -- But it's a little awkward, so I'm leaving it alone for now
+ -- and it maintains uniformity with other rebindable syntax
+ ; return (HsIf (Just fun') pred' b1' b2') }
tcExpr (HsDo do_or_lc stmts body _) res_ty
= tcDoStmts do_or_lc stmts body res_ty
ptext (sLit "was found where an expression was expected")])
\end{code}
+Note [Rebindable syntax for if]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The rebindable syntax for 'if' uses the most flexible possible type
+for conditionals:
+ ifThenElse :: p -> b1 -> b2 -> res
+to support expressions like this:
+
+ ifThenElse :: Maybe a -> (a -> b) -> b -> b
+ ifThenElse (Just a) f _ = f a ifThenElse Nothing _ e = e
+
+ example :: String
+ example = if Just 2
+ then \v -> show v
+ else "No value"
+
+
%************************************************************************
%* *
Record construction and update