Fix #10079 by recurring after flattening exposes a TyConApp.
authorRichard Eisenberg <eir@cis.upenn.edu>
Wed, 11 Feb 2015 18:06:15 +0000 (13:06 -0500)
committerRichard Eisenberg <eir@cis.upenn.edu>
Wed, 11 Feb 2015 18:13:29 +0000 (13:13 -0500)
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.

compiler/typecheck/TcCanonical.hs
testsuite/tests/indexed-types/should_compile/T10079.hs [new file with mode: 0644]
testsuite/tests/indexed-types/should_compile/all.T

index cdf5f09..b4ec62a 100644 (file)
@@ -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 (file)
index 0000000..6651a74
--- /dev/null
@@ -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
index 9f76c7d..f4df933 100644 (file)
@@ -251,3 +251,4 @@ test('T9747', normal, compile, [''])
 test('T9582', normal, compile, [''])
 test('T9090', normal, compile, [''])
 test('T10020', normal, compile, [''])
+test('T10079', normal, compile, [''])