[commit: ghc] master: Treat funTyCon like any other TyCon in can_eq_nc. (298c424)

[git at git.haskell.org]

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

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

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

commit 298c4244022546842390e51c04b08760d884a6dc
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Mon Jun 15 20:49:10 2015 -0400

    Treat funTyCon like any other TyCon in can_eq_nc.
    
    Custom treatment of FunTys in can_eq_nc' interfered with the new
    handling of decomposing equalities.


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

298c4244022546842390e51c04b08760d884a6dc
 compiler/typecheck/TcCanonical.hs                  | 28 ++++------------------
 .../tests/typecheck/should_compile/RepArrow.hs     |  4 ++--
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 3 files changed, 8 insertions(+), 25 deletions(-)

diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index 2db2c71..47be054 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -455,32 +455,14 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _
        ; stopWith ev "Equal LitTy" }
 
 -- Decomposable type constructor applications
--- Synonyms and type functions (which are not decomposable)
--- have already been dealt with
-can_eq_nc' _flat _rdr_env _envs ev eq_rel
-          (TyConApp tc1 tys1) _ (TyConApp tc2 tys2) _
-  | mightBeUnsaturatedTyCon tc1
-  , mightBeUnsaturatedTyCon tc2
+can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1 _ ty2 _
+  | Just (tc1, tys1) <- tcSplitTyConApp_maybe ty1
+  , Just (tc2, tys2) <- tcSplitTyConApp_maybe ty2
+  , not (isTypeFamilyTyCon tc1)
+  , not (isTypeFamilyTyCon tc2)
   = canTyConApp ev eq_rel tc1 tys1 tc2 tys2
 
 can_eq_nc' _flat _rdr_env _envs ev eq_rel
-           (TyConApp tc1 _) ps_ty1 (FunTy {}) ps_ty2
-  | mightBeUnsaturatedTyCon tc1
-      -- The guard is important
-      -- e.g.  (x -> y) ~ (F x y) where F has arity 1
-      --       should not fail, but get the app/app case
-  = canEqHardFailure ev eq_rel ps_ty1 ps_ty2
-
-can_eq_nc' _flat _rdr_env _envs ev eq_rel (FunTy s1 t1) _ (FunTy s2 t2) _
-  = do { canDecomposableTyConAppOK ev eq_rel funTyCon [s1,t1] [s2,t2]
-       ; stopWith ev "Decomposed FunTyCon" }
-
-can_eq_nc' _flat _rdr_env _envs ev eq_rel
-          (FunTy {}) ps_ty1 (TyConApp tc2 _) ps_ty2
-  | mightBeUnsaturatedTyCon tc2
-  = canEqHardFailure ev eq_rel ps_ty1 ps_ty2
-
-can_eq_nc' _flat _rdr_env _envs ev eq_rel
            s1@(ForAllTy {}) _ s2@(ForAllTy {}) _
  | CtWanted { ctev_loc = loc, ctev_evar = orig_ev } <- ev
  = do { let (tvs1,body1) = tcSplitForAllTys s1
diff --git a/testsuite/tests/typecheck/should_compile/RepArrow.hs b/testsuite/tests/typecheck/should_compile/RepArrow.hs
index d891387..6a9df79 100644
--- a/testsuite/tests/typecheck/should_compile/RepArrow.hs
+++ b/testsuite/tests/typecheck/should_compile/RepArrow.hs
@@ -5,5 +5,5 @@ module RepArrow where
 import Data.Ord ( Down )  -- convenient "Id" newtype, without its constructor
 import Data.Coerce
 
-foo :: Coercible (Down (Int -> Int)) (Int -> Int) => ()
-foo = ()
+foo :: Coercible (Down (Int -> Int)) (Int -> Int) => Down (Int -> Int) -> Int -> Int
+foo = coerce
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 17a3918..8165087 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -462,3 +462,4 @@ test('T10348', normal, compile, [''])
 test('T10494', normal, compile, [''])
 test('T10493', normal, compile, [''])
 test('T10428', normal, compile, [''])
+test('RepArrow', normal, compile, [''])