Comments and variable names only, in type checking of (e1 $ e2)
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 8 Dec 2014 13:10:05 +0000 (13:10 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 8 Dec 2014 13:39:39 +0000 (13:39 +0000)
No change in behaviour

compiler/typecheck/TcExpr.hs

index 763be05..9503d2b 100644 (file)
@@ -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')