
#11715: Constraint vs * -------------------------------------+------------------------------------- Reporter: bgamari | Owner: goldfire Type: bug | Status: new Priority: highest | Milestone: 8.4.1 Component: Compiler (Type | Version: 8.0.1-rc1 checker) | Keywords: Typeable, Resolution: | LevityPolymorphism, Roles Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by adamgundry): I'm inclined to agree with the proposal to use `coreView` in class/family instances, so we would regard an instance of `Typeable * Constraint` as overlapping `Typeable * Type` and hence not be able to solve the former. FWIW, here's an actual implementation of `unsafeCoerce` in GHC 8.0.2 exploiting this bug: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes, TypeFamilies, TypeOperators #-} import Data.Kind import Data.Typeable type family F x a b type instance F Type a b = a type instance F Constraint a b = b foo :: x :~: y -> F x a b -> F y a b foo Refl = id unsafeCoerce :: a -> b unsafeCoerce x = case eqT :: Maybe (Type :~: Constraint) of Nothing -> error "No more bug!" Just r -> foo r x }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11715#comment:71 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler