
#11480: UndecidableSuperClasses causes the compiler to spin with UndecidableInstances -------------------------------------+------------------------------------- Reporter: ekmett | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1-rc1 checker) | Keywords: PolyKinds, Resolution: | UndecidableSuperClasses Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #10318 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ekmett): There also seems to be a bad interaction with the `?callStack` machinery. Here is a differently modified test case: {{{ {-# language KindSignatures, PolyKinds, DataKinds, TypeFamilies, RankNTypes, NoImplicitPrelude, FlexibleContexts, MultiParamTypeClasses, GADTs, ConstraintKinds, FlexibleInstances, TypeOperators, ScopedTypeVariables, UndecidableSuperClasses, FunctionalDependencies #-} import GHC.Types (Constraint) import qualified Prelude data Dict p where Dict :: p => Dict p newtype p :- q = Sub (p => Dict q) data Nat (c :: i -> i -> *) (d :: j -> j -> *) (f :: i -> j) (g :: i -> j) class Functor p (Nat p (->)) p => Category (p :: i -> i -> *) where type Ob p :: i -> Constraint class (Category dom, Category cod) => Functor (dom :: i -> i -> *) (cod :: j -> j -> *) (f :: i -> j) | f -> dom cod bug :: Functor c d f => Ob c a :- Ob d (f a) bug = Prelude.undefined }}} I attempted to place `undefined` there as a placeholder while I worked on the surrounding code, but compiling `bug` causes {{{ solveWanteds: too many iterations (limit = 4) Unsolved: WC {wc_simple = [W] $dIP_a15a :: ?callStack::GHC.Stack.Types.CallStack (CDictCan)} New superclasses found Set limit with -fconstraint-solver-iterations=n; n=0 for no limit }}} Raising the limit gets me right back to the same unsolved constraint. Without the class cycle, we don't spin forever trying to find a `?callStack`. It seems odd that looking for `?callStack` would cause us to unroll superclasses though, as implicit parameters can't be a superclass of any class. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11480#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler