[GHC] #10670: panic! ASSERT failed compiler/types/Type.hs line 1712
GHC
ghc-devs at haskell.org
Wed Jul 22 15:09:12 UTC 2015
#10670: panic! ASSERT failed compiler/types/Type.hs line 1712
-------------------------------------+-------------------------------------
Reporter: bjmprice | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.11
Keywords: | Operating System: Linux
Architecture: x86_64 | Type of failure: Compile-time
(amd64) | crash
Test Case: | Blocked By:
Blocking: | Related Tickets:
Differential Revisions: |
-------------------------------------+-------------------------------------
The following code causes a panic when loaded into GHCi
(more complicated code below makes GHC panic also)
{{{#!hs
{-# LANGUAGE GADTs , PolyKinds #-}
module Bug where
data TyConT (a::k) = TyConT String
tyConTArr :: TyConT (->)
tyConTArr = TyConT "(->)"
data G2 c a where
G2 :: TyConT a -> TyConT b -> G2 c (c a b)
getT2 :: TyConT (c :: k2 -> k1 -> k) -> TyConT (a :: k) -> Maybe (G2 c a)
getT2 (TyConT c) (TyConT a) = Nothing
s tf = case getT2 tyConTArr tf
of Just (G2 _ _) -> Nothing
_ -> Nothing
}}}
`ghci Bug.hs` yields
{{{
ghc-stage2: panic! (the 'impossible' happened)
(GHC version 7.11.20150717 for x86_64-unknown-linux):
ASSERT failed!
file compiler/types/Type.hs line 1712
a_ame -> b_amf
k_anj
}}}
And for GHC:
{{{#!hs
{-# LANGUAGE GADTs , PolyKinds , FlexibleInstances , TypeOperators ,
ScopedTypeVariables #-}
module Bug2 where
import Unsafe.Coerce
data TyConT (a::k) = TyConT String
eqTyConT :: TyConT a -> TyConT b -> Bool
eqTyConT (TyConT a) (TyConT b) = a == b
tyConTArr :: TyConT (->)
tyConTArr = TyConT "(->)"
data TypeRepT (a::k) where
TRCon :: TyConT a -> TypeRepT a
TRApp :: TypeRepT a -> TypeRepT b -> TypeRepT (a b)
data GetAppT a where
GA :: TypeRepT a -> TypeRepT b -> GetAppT (a b)
getAppT :: TypeRepT a -> Maybe (GetAppT a)
getAppT (TRApp a b) = Just $ GA a b
getAppT _ = Nothing
eqTT :: TypeRepT (a::k1) -> TypeRepT (b::k2) -> Bool
eqTT (TRCon a) (TRCon b) = eqTyConT a b
eqTT (TRApp c a) (TRApp d b) = eqTT c d && eqTT a b
eqTT _ _ = False
data G2 c a where
G2 :: TypeRepT a -> TypeRepT b -> G2 c (c a b)
getT2 :: TypeRepT (c :: k2 -> k1 -> k) -> TypeRepT (a :: k) -> Maybe (G2 c
a)
getT2 c t = do GA t' b <- getAppT t
GA c' a <- getAppT t'
if eqTT c c'
then Just (unsafeCoerce $ G2 a b :: G2 c a)
else Nothing
tyRepTArr :: TypeRepT (->)
tyRepTArr = TRCon tyConTArr
s tf = case getT2 tyRepTArr tf
of Just (G2 _ _) -> Nothing
_ -> Nothing
}}}
`ghc Bug2.hs` yields
{{{
[1 of 1] Compiling Bug2 ( Bug2.hs, Bug2.o )
ghc-stage2: panic! (the 'impossible' happened)
(GHC version 7.11.20150717 for x86_64-unknown-linux):
ASSERT failed!
file compiler/types/Type.hs line 1712
a_amr -> b_ams
k_a1c2
Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
}}}
This is a regression from 7.10.1 (fails at
1224bb55cac502fe04005345aad47a6bc5c4a297)
`uname -a`:
`Linux cam-05-unx 3.5.0-54-generic #81~precise1-Ubuntu SMP Tue Jul 15
04:02:22 UTC 2014 x86_64 x86_64 x86_64 GNU/Linux`
using GCC 4.6.3
`gcc -v` output:
{{{
Using built-in specs.
COLLECT_GCC=gcc
COLLECT_LTO_WRAPPER=/usr/lib/gcc/x86_64-linux-gnu/4.6/lto-wrapper
Target: x86_64-linux-gnu
Configured with: ../src/configure -v --with-pkgversion='Ubuntu/Linaro
4.6.3-1ubuntu5' --with-bugurl=file:///usr/share/doc/gcc-4.6/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --program-
suffix=-4.6 --enable-shared --enable-linker-build-id --with-system-zlib
--libexecdir=/usr/lib --without-included-gettext --enable-threads=posix
--with-gxx-include-dir=/usr/include/c++/4.6 --libdir=/usr/lib --enable-nls
--with-sysroot=/ --enable-clocale=gnu --enable-libstdcxx-debug --enable-
libstdcxx-time=yes --enable-gnu-unique-object --enable-plugin --enable-
objc-gc --disable-werror --with-arch-32=i686 --with-tune=generic --enable-
checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu
--target=x86_64-linux-gnu
Thread model: posix
gcc version 4.6.3 (Ubuntu/Linaro 4.6.3-1ubuntu5)
}}}
`ghc -v Bug2.hs`:
{{{
Glasgow Haskell Compiler, Version 7.11.20150717, stage 2 booted by GHC
version 7.10.1
Using binary package database: /5playpen/t-bepric/ghc-
build/inplace/lib/package.conf.d/package.cache
Using binary package database:
/home/t-bepric/.ghc/x86_64-linux-7.11.20150717/package.conf.d/package.cache
wired-in package ghc-prim mapped to ghc-prim-0.4.0.0-inplace
wired-in package integer-gmp mapped to integer-gmp-1.0.0.0-inplace
wired-in package base mapped to base-4.8.2.0-inplace
wired-in package rts mapped to builtin_rts
wired-in package template-haskell mapped to template-
haskell-2.10.0.0-inplace
wired-in package ghc mapped to ghc-7.11.20150717-inplace
wired-in package dph-seq not found.
wired-in package dph-par not found.
Hsc static flags:
wired-in package ghc-prim mapped to ghc-prim-0.4.0.0-inplace
wired-in package integer-gmp mapped to integer-gmp-1.0.0.0-inplace
wired-in package base mapped to base-4.8.2.0-inplace
wired-in package rts mapped to builtin_rts
wired-in package template-haskell mapped to template-
haskell-2.10.0.0-inplace
wired-in package ghc mapped to ghc-7.11.20150717-inplace
wired-in package dph-seq not found.
wired-in package dph-par not found.
*** Chasing dependencies:
Chasing modules from: *Bug2.hs
Stable obj: []
Stable BCO: []
Ready for upsweep
[NONREC
ModSummary {
ms_hs_date = 2015-07-22 15:01:01 UTC
ms_mod = Bug2,
ms_textual_imps = [import (implicit) Prelude, import
Unsafe.Coerce]
ms_srcimps = []
}]
*** Deleting temp files:
Deleting:
compile: input file Bug2.hs
Created temporary directory: /tmp/ghc33699_0
*** Checking old interface for Bug2:
[1 of 1] Compiling Bug2 ( Bug2.hs, Bug2.o )
*** Parser:
*** Renamer/typechecker:
*** Desugar:
Result size of Desugar (before optimization)
= {terms: 206, types: 667, coercions: 24}
Result size of Desugar (after optimization)
= {terms: 133, types: 421, coercions: 10}
*** Simplifier:
*** Deleting temp files:
Deleting: /tmp/ghc33699_0/ghc_1.s
Warning: deleting non-existent /tmp/ghc33699_0/ghc_1.s
*** Deleting temp dirs:
Deleting: /tmp/ghc33699_0
ghc-stage2: panic! (the 'impossible' happened)
(GHC version 7.11.20150717 for x86_64-unknown-linux):
ASSERT failed!
file compiler/types/Type.hs line 1712
a_amr -> b_ams
k_a1c2
}}}
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/10670>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list