Avoid recursive use of immSuperClasses
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 25 Jan 2016 08:29:12 +0000 (08:29 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 25 Jan 2016 11:32:29 +0000 (11:32 +0000)
In fixing Trac #11480 I had omitted to deal with FunDeps.oclose,
which was making recursive use of immSuperClasses, and hence
going into a loop in the recursive case.

Solution: use transSuperClasses, which takes care not to.

compiler/typecheck/FunDeps.hs
compiler/typecheck/TcType.hs
testsuite/tests/polykinds/T11480a.hs

index 1a0c310..72d8345 100644 (file)
@@ -23,7 +23,7 @@ import Name
 import Var
 import Class
 import Type
-import TcType( immSuperClasses )
+import TcType( transSuperClasses )
 import Unify
 import InstEnv
 import VarSet
@@ -510,18 +510,17 @@ oclose preds fixed_tvs
     tv_fds  :: [(TyCoVarSet,TyCoVarSet)]
     tv_fds  = [ (tyCoVarsOfTypes ls, tyCoVarsOfTypes rs)
               | pred <- preds
-              , (ls, rs) <- determined pred ]
+              , pred' <- pred : transSuperClasses pred
+                   -- Look for fundeps in superclasses too
+              , (ls, rs) <- determined pred' ]
 
     determined :: PredType -> [([Type],[Type])]
     determined pred
        = case classifyPredType pred of
             EqPred NomEq t1 t2 -> [([t1],[t2]), ([t2],[t1])]
-            ClassPred cls tys -> local_fds ++ concatMap determined superclasses
-              where
-               local_fds = [ instFD fd cls_tvs tys
-                           | fd <- cls_fds ]
-               (cls_tvs, cls_fds) = classTvsFds cls
-               superclasses = immSuperClasses cls tys
+            ClassPred cls tys  -> [ instFD fd cls_tvs tys
+                                  | let (cls_tvs, cls_fds) = classTvsFds cls
+                                  , fd <- cls_fds ]
             _ -> []
 
 {-
index c5edfb5..62095c7 100644 (file)
@@ -1720,8 +1720,8 @@ mkMinimalBySCs ptys = go preds_with_scs []
    in_cloud p ps = or [ p `eqType` p' | (_, scs) <- ps, p' <- scs ]
 
 transSuperClasses :: PredType -> [PredType]
--- (transSuperClasses p) returns (p's superclasses)
--- not including p
+-- (transSuperClasses p) returns (p's superclasses) not including p
+-- Stop if you encounter the same class again
 -- See Note [Expanding superclasses]
 transSuperClasses p
   = go emptyNameSet p
index 3d17168..eeeaf34 100644 (file)
@@ -1,7 +1,7 @@
 {-# language KindSignatures, PolyKinds, TypeFamilies,
   NoImplicitPrelude, FlexibleContexts,
   MultiParamTypeClasses, GADTs,
-  ConstraintKinds, FlexibleInstances,
+  ConstraintKinds, FlexibleInstances, UndecidableInstances,
   FunctionalDependencies, UndecidableSuperClasses #-}
 
 module T11480a where