[GHC] #13345: GHC 8 type checker regression

#13345: GHC 8 type checker regression -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 (Type checker) | Keywords: type | Operating System: Unknown/Multiple annotation | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- GHC 8.0.1/2 needs a type annotation where GHC 7.8 can do without: {{{#!hs {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-} data T = Var | App T T data S = S class Tr a b where tr :: a -> b tr = undefined instance Tr S T where instance Tr a b => Tr [a] [b] where test :: [S] -> T test es = let -- es' :: [T] -- This type annotation is not needed by ghc-7.8 es' = tr es in foldl App Var es' }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13345 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13345: GHC 8 type checker regression -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.2 checker) | Keywords: type Resolution: invalid | annotation Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => invalid Comment: First, note that this started to error on GHC 7.10.3, not GHC 8.0: {{{ Bug.hs:17:11: No instance for (Tr [S] (t0 T)) arising from a use of ‘tr’ The type variable ‘t0’ is ambiguous Relevant bindings include es' :: t0 T (bound at Bug.hs:17:5) Note: there is a potential instance available: instance Tr a b => Tr [a] [b] -- Defined at Bug.hs:12:10 In the expression: tr es In an equation for ‘es'’: es' = tr es In the expression: let es' = tr es in foldl App Var es' Bug.hs:18:6: No instance for (Foldable t0) arising from a use of ‘foldl’ The type variable ‘t0’ is ambiguous Relevant bindings include es' :: t0 T (bound at Bug.hs:17:5) Note: there are several potential instances: instance Foldable (Either a) -- Defined in ‘Data.Foldable’ instance Foldable Data.Proxy.Proxy -- Defined in ‘Data.Foldable’ instance GHC.Arr.Ix i => Foldable (GHC.Arr.Array i) -- Defined in ‘Data.Foldable’ ...plus three others In the expression: foldl App Var es' In the expression: let es' = tr es in foldl App Var es' In an equation for ‘test’: test es = let es' = tr es in foldl App Var es' }}} That `No instance for (Foldable t0)` reveals why: the type signature of `foldl` was generalized from: {{{#!hs foldl :: (b -> a -> b) -> b -> [a] -> b }}} to: {{{#!hs foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b }}} Indeed, if you locally redefine `foldl` to use the former type signature: {{{#!hs {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-} import Prelude hiding (foldl) import qualified Prelude data T = Var | App T T data S = S class Tr a b where tr :: a -> b tr = undefined instance Tr S T where instance Tr a b => Tr [a] [b] where foldl :: (b -> a -> b) -> b -> [a] -> b foldl = Prelude.foldl test :: [S] -> T test es = let es' = tr es in foldl App Var es' }}} Then it will typecheck on GHC 7.10 and 8.0. Alternatively, you can just give a type signature to `es'`, which is arguably cleaner. So this isn't a change in typechecker behavior at all, just a library design choice. See also [https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#GHCsaysNoinstanceforFol...... this], which details what would happen if you tried to use a `Foldable` function on a `String` with `OverloadedStrings` on. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13345#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#13345: GHC 8 type checker regression -------------------------------------+------------------------------------- Reporter: andreas.abel | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.2 checker) | Keywords: type Resolution: invalid | annotation 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 andreas.abel): Well, I also tried {{{#!hs import qualified Data.List as List }}} and then use `List.foldl`, but it did not help. If this is "just a library design choice", maybe something went wrong there, but `base` is an integral part of `ghc`, thus, it is still a regression in that respect. What does work is to use `FunctionalDependencies` for the `Tr` class. But since this feature is still underdeveloped, not knowing about injectivity of type constructors, I also have to turn on the sledgehammer `UndecidableInstances`. If not a bug, at least the situation is unpleasant. There is no nice workaround. Except breaking up the code to smaller pieces and insert type annotations. (The original code was monadic, like:) {{{#!hs List.fold App Var <$> tr es }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13345#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC