diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-12-08 13:10:05 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2014-12-08 13:39:39 +0000 |
| commit | d64e682824631bc2a424f40b2776a2fbf457d122 (patch) | |
| tree | c23918062382eb52f707b66644b637b2c2538f94 | |
| parent | 15a54bedbbbcfc83a4af5eff7c8b2c1f0181fbd1 (diff) | |
| download | haskell-d64e682824631bc2a424f40b2776a2fbf457d122.tar.gz | |
Comments and variable names only, in type checking of (e1 $ e2)
No change in behaviour
| -rw-r--r-- | compiler/typecheck/TcExpr.hs | 28 |
1 files changed, 14 insertions, 14 deletions
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 763be05922..9503d2b950 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -314,29 +314,29 @@ tcExpr (OpApp arg1 op fix arg2) res_ty ; let doc = ptext (sLit "The first argument of ($) takes") ; (co_arg1, [arg2_ty], op_res_ty) <- matchExpectedFunTys doc 1 arg1_ty - -- arg1_ty = arg2_ty -> op_res_ty - -- And arg2_ty maybe polymorphic; that's the point + + -- We have (arg1 $ arg2) + -- So: arg1_ty = arg2_ty -> op_res_ty + -- where arg2_ty maybe polymorphic; that's the point + + ; arg2' <- tcArg op (arg2, arg2_ty, 2) + ; co_b <- unifyType op_res_ty res_ty -- op_res ~ res -- Make sure that the argument type has kind '*' + -- ($) :: forall (a2:*) (r:Open). (a2->r) -> a2 -> r -- Eg we do not want to allow (D# $ 4.0#) Trac #5570 -- (which gives a seg fault) -- We do this by unifying with a MetaTv; but of course -- it must allow foralls in the type it unifies with (hence ReturnTv)! -- - -- The result type can have any kind (Trac #8739), - -- so we can just use res_ty - - -- ($) :: forall (a:*) (b:Open). (a->b) -> a -> b - ; a_tv <- newReturnTyVar liftedTypeKind - ; let a_ty = mkTyVarTy a_tv + -- The *result* type can have any kind (Trac #8739), + -- so we don't need to check anything for that + ; a2_tv <- newReturnTyVar liftedTypeKind + ; let a2_ty = mkTyVarTy a2_tv + ; co_a <- unifyType arg2_ty a2_ty -- arg2 ~ a2 - ; arg2' <- tcArg op (arg2, arg2_ty, 2) - - ; co_a <- unifyType arg2_ty a_ty -- arg2 ~ a - ; co_b <- unifyType op_res_ty res_ty -- op_res ~ res ; op_id <- tcLookupId op_name - - ; let op' = L loc (HsWrap (mkWpTyApps [a_ty, res_ty]) (HsVar op_id)) + ; let op' = L loc (HsWrap (mkWpTyApps [a2_ty, res_ty]) (HsVar op_id)) ; return $ OpApp (mkLHsWrapCo (mkTcFunCo Nominal co_a co_b) $ mkLHsWrapCo co_arg1 arg1') |