
#7777: ghc panic: varargs + sets -------------------------------+-------------------------------------------- Reporter: litherum | Owner: Type: bug | Status: new Priority: normal | Component: Compiler Version: 7.4.1 | Keywords: MultiParamTypeClasses FunctionalDependencies FlexibleInstances UndecidableInstances Os: Linux | Architecture: Unknown/Multiple Failure: Compile-time crash | Blockedby: Blocking: | Related: -------------------------------+-------------------------------------------- This program: {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} import qualified Data.Set as S class BuildSet a b | b -> a where buildset' :: S.Set a -> a -> b instance Ord a => BuildSet a (S.Set a) where buildset' s i = S.insert i s instance Ord a => BuildSet a b => BuildSet a (a -> b) where buildset' s i = \ i2 -> buildset' (S.insert i s) i2 buildset :: BuildSet a b => a -> b buildset = buildset' S.empty s1 :: S.Set Integer s1 = buildset 3 s2 :: S.Set Integer s2 = buildset 1 2 3 s3 :: S.Set Integer s3 = buildset 8 4 2 1 2 4 8 18 main = do putStrLn $ show l1 putStrLn $ show l2 putStrLn $ show l3 produces this output when compiled: $ ghc --make test.hs [1 of 1] Compiling Main ( test.hs, test.o ) ghc: panic! (the 'impossible' happened) (GHC version 7.4.1 for x86_64-unknown-linux): compiler/rename/RnSource.lhs:429:14-81: Irrefutable pattern failed for pattern Data.Maybe.Just (inst_tyvars, _, SrcLoc.L _ cls, _) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug $ ghc --version The Glorious Glasgow Haskell Compilation System, version 7.4.1 -- Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/7777 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler