[commit: ghc] master: Comments and variable names only, in type checking of (e1 $ e2) (d64e682)

git at git.haskell.org git at git.haskell.org
Mon Dec 8 15:02:13 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d64e682824631bc2a424f40b2776a2fbf457d122/ghc

>---------------------------------------------------------------

commit d64e682824631bc2a424f40b2776a2fbf457d122
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Dec 8 13:10:05 2014 +0000

    Comments and variable names only, in type checking of (e1 $ e2)
    
    No change in behaviour


>---------------------------------------------------------------

d64e682824631bc2a424f40b2776a2fbf457d122
 compiler/typecheck/TcExpr.hs | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 763be05..9503d2b 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')



More information about the ghc-commits mailing list