[commit: ghc] master: Fix #10079 by recurring after flattening exposes a TyConApp. (befe2d7)

[git at git.haskell.org]

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

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

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

commit befe2d7c8902096dd184ebca3f7f135ee5f479e8
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Wed Feb 11 13:06:15 2015 -0500

    Fix #10079 by recurring after flattening exposes a TyConApp.
    
    Previously, try_decompose_nom_app was smart enough to recur if
    flattening exposed a TyConApp, but try_decompose_repr_app was
    not. Now, if neither type in try_decompose_repr_app is an AppTy,
    recur.
    
    Seems all straightforward enough to avoid a Note.


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

befe2d7c8902096dd184ebca3f7f135ee5f479e8
 compiler/typecheck/TcCanonical.hs                    | 13 +++++++++++--
 .../tests/indexed-types/should_compile/T10079.hs     | 20 ++++++++++++++++++++
 testsuite/tests/indexed-types/should_compile/all.T   |  1 +
 3 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index cdf5f09..b4ec62a 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -680,9 +680,18 @@ try_decompose_repr_app ev ty1 ty2
   | ty1 `eqType` ty2   -- See Note [AppTy reflexivity check]
   = canEqReflexive ev ReprEq ty1
 
-  | otherwise
+  | AppTy {} <- ty1
+  = canEqFailure ev ReprEq ty1 ty2
+
+  | AppTy {} <- ty2
   = canEqFailure ev ReprEq ty1 ty2
 
+  | otherwise  -- flattening in can_eq_wanted_app exposed some TyConApps!
+  = ASSERT2( isJust (tcSplitTyConApp_maybe ty1) || isJust (tcSplitTyConApp_maybe ty2)
+            , ppr ty1 $$ ppr ty2 )  -- If this assertion fails, we may fall
+                                    -- into an infinite loop
+    canEqNC ev ReprEq ty1 ty2
+
 ---------
 try_decompose_nom_app :: CtEvidence
                       -> TcType -> TcType -> TcS (StopOrContinue Ct)
@@ -705,7 +714,7 @@ try_decompose_nom_app ev ty1 ty2
                 -- is good: See Note [Canonicalising type applications]
    = ASSERT2( isJust (tcSplitTyConApp_maybe ty1) || isJust (tcSplitTyConApp_maybe ty2)
             , ppr ty1 $$ ppr ty2 )  -- If this assertion fails, we may fall
-                                    -- into an inifinite loop (Trac #9971)
+                                    -- into an infinite loop (Trac #9971)
      canEqNC ev NomEq ty1 ty2
    where
      -- Recurses to try_decompose_nom_app to decompose a chain of AppTys
diff --git a/testsuite/tests/indexed-types/should_compile/T10079.hs b/testsuite/tests/indexed-types/should_compile/T10079.hs
new file mode 100644
index 0000000..6651a74
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T10079.hs
@@ -0,0 +1,20 @@
+
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleContexts #-}
+module T10079 where
+
+import Control.Applicative
+import Data.Coerce
+
+broken :: Bizarre (->) w => w a b t -> ()
+broken = getConst #. bazaar (Const #. const ())
+
+class Profunctor p where
+  (#.) :: Coercible c b => (b -> c) -> p a b -> p a c
+
+instance Profunctor (->) where
+  (#.) = (.)
+
+class Bizarre p w | w -> p where 
+  bazaar :: Applicative f => p a (f b) -> w a b t -> f t
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index 9f76c7d..f4df933 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -251,3 +251,4 @@ test('T9747', normal, compile, [''])
 test('T9582', normal, compile, [''])
 test('T9090', normal, compile, [''])
 test('T10020', normal, compile, [''])
+test('T10079', normal, compile, [''])