[commit: ghc] wip/impredicativity: Fix bug on the generation of HsWrappers (59a2764)

[git at git.haskell.org]

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

On branch  : wip/impredicativity
Link       : http://ghc.haskell.org/trac/ghc/changeset/59a276484a58dc64e4e8b6857978422df01e4487/ghc

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

commit 59a276484a58dc64e4e8b6857978422df01e4487
Author: Alejandro Serrano <trupill at gmail.com>
Date:   Mon Jun 29 15:00:21 2015 +0200

    Fix bug on the generation of HsWrappers


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

59a276484a58dc64e4e8b6857978422df01e4487
 compiler/typecheck/TcExpr.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 860d301..33f59e6 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -1226,19 +1226,20 @@ tc_check_id orig id_name res_ty
                -> do { (expr, actual_ty) <- case cl of
                           RealDataCon con -> inst_data_con con
                           PatSynCon ps    -> tcPatSynBuilderOcc orig ps
-                     ; co <- unifyType res_ty actual_ty
-                     ; return (mkHsWrap (mkWpCast co) expr) }
+                     ; co <- unifyType actual_ty res_ty
+                     ; return (mkHsWrapCo co expr) }
 
              _ -> failWithTc $
                   ppr thing <+> ptext (sLit "used where a value identifier was expected") }
   where
     inst_normal_id orig id res_ty flavor
       = do { let actual_ty = idType id
-           ; case flavor of
-               TcIdMonomorphic
-                 -> do { co <- unifyType res_ty actual_ty
-                       ; return (mkHsWrap (mkWpCast co) (HsVar id)) }
-               TcIdUnrestricted
+           ; case (res_ty `eqType` actual_ty, flavor) of
+               (True, _) -> return (HsVar id)
+               (False, TcIdMonomorphic)
+                 -> do { co <- unifyType actual_ty res_ty
+                       ; return (mkHsWrapCo co (HsVar id)) }
+               (False, TcIdUnrestricted)
                  -> do { ev <- emitWanted orig (mkInstanceOfPred actual_ty res_ty)
                        ; return (mkHsWrap (mkWpInstanceOf actual_ty ev) (HsVar id)) } }