[GHC] #10617: Panic in GHCi debugger with GADTs, PolyKinds and Phantom types

GHC ghc-devs at haskell.org
Wed Jul 8 14:55:02 UTC 2015


#10617: Panic in GHCi debugger with GADTs, PolyKinds and Phantom types
-----------------------------------------+-------------------------------
              Reporter:  bjmprice        |             Owner:
                  Type:  bug             |            Status:  new
              Priority:  normal          |         Milestone:
             Component:  GHCi            |           Version:  7.10.1
              Keywords:                  |  Operating System:  Linux
          Architecture:  x86_64 (amd64)  |   Type of failure:  GHCi crash
             Test Case:                  |        Blocked By:
              Blocking:                  |   Related Tickets:
Differential Revisions:                  |
-----------------------------------------+-------------------------------
 Potentially related: #10616 (I noticed this one first, and in simplifying
 the code it changed to that error - note TcUnify.hs vs TcType.hs)

 The code
 {{{#!hs
 {-# LANGUAGE GADTs , PolyKinds #-}

 data AppTreeT (a::k) where
   Con :: AppTreeT a
   App :: AppTreeT a -> AppTreeT b -> AppTreeT (a b)

 tmt :: AppTreeT (Maybe Bool)
 tmt = App (Con :: AppTreeT Maybe) Con

 f :: AppTreeT a -> Bool
 f (App (c at Con) _) = const True c
 f _ = False
 }}}
 when loaded in ghci runs fine without breakpoints, but panics when
 breaking on {{{f (App )c at Con) _) = ...}}}:
 {{{
 *Main> f tmt
 True
 *Main> :break 11
 Breakpoint 0 activated at DebuggerCrash2.hs:11:21-32
 *Main> f tmt
 ghc-stage2: panic! (the 'impossible' happened)
   (GHC version 7.11.20150708 for x86_64-unknown-linux):
         ASSERT failed! file compiler/typecheck/TcType.hs line 739 k_anx
 }}}

 It fails to load in 7.4.1: {{{DebuggerCrash2.hs:3:19: parse error on input
 `k'}}}
 It fails to load in 7.8.2:
 {{{
 DebuggerCrash2.hs:5:50:
     Kind occurs check
     The first argument of ‘a’ should have kind ‘k0’,
       but ‘b’ has kind ‘k0 -> k1’
     In the type ‘AppTreeT (a b)’
     In the definition of data constructor ‘App’
     In the data declaration for ‘AppTreeT’

 }}}
 It has the panic in both 7.10.1 and
 HEAD at d71b65f53a1daa2631d2c818c7ea6add77813532

 {{{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}}}
 {{{
 gcc -v:
 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)
 }}}

 With {{{ghci-7.10.1 -v}}}
 {{{
 GHCi, version 7.10.1: http://www.haskell.org/ghc/  :? for help
 Glasgow Haskell Compiler, Version 7.10.1, stage 2 booted by GHC version
 7.8.2
 Using binary package database:
 /5playpen/t-bepric/ghc-7.10.1-build/inplace/lib/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.0.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.10.1-inplace
 wired-in package dph-seq not found.
 wired-in package dph-par not found.
 Hsc static flags:
 Loading package ghc-prim-0.4.0.0 ... linking ... done.
 *** gcc:
 /usr/bin/gcc -fno-stack-protector -DTABLES_NEXT_TO_CODE
 -L/5playpen/t-bepric/ghc-7.10.1-build/libraries/integer-gmp2/dist-
 install/build --print-file-name libgmp.so
 Loading package integer-gmp-1.0.0.0 ... linking ... done.
 Loading package base-4.8.0.0 ... linking ... done.
 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.0.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.10.1-inplace
 wired-in package dph-seq not found.
 wired-in package dph-par not found.
 *** Chasing dependencies:
 Chasing modules from:
 Stable obj: []
 Stable BCO: []
 unload: retaining objs []
 unload: retaining bcos []
 Ready for upsweep []
 Upsweep completely successful.
 *** Deleting temp files:
 Deleting:
 *** Chasing dependencies:
 Chasing modules from: *DebuggerCrash2.hs
 Stable obj: []
 Stable BCO: []
 unload: retaining objs []
 unload: retaining bcos []
 Ready for upsweep
   [NONREC
       ModSummary {
          ms_hs_date = 2015-07-08 13:56:59 UTC
          ms_mod = Main,
          ms_textual_imps = [import (implicit) Prelude]
          ms_srcimps = []
       }]
 *** Deleting temp files:
 Deleting:
 compile: input file DebuggerCrash2.hs
 Created temporary directory: /tmp/ghc22446_0
 *** Checking old interface for Main:
 [1 of 1] Compiling Main             ( DebuggerCrash2.hs, interpreted )
 *** Parser:
 *** Renamer/typechecker:
 *** Desugar:
 Result size of Desugar (before optimization)
   = {terms: 32, types: 72, coercions: 1}
 Result size of Desugar (after optimization)
   = {terms: 26, types: 55, coercions: 0}
 *** Simplifier:
 Result size of Simplifier iteration=1
   = {terms: 24, types: 79, coercions: 2}
 Result size of Simplifier = {terms: 21, types: 76, coercions: 2}
 *** Tidy Core:
 Result size of Tidy Core = {terms: 31, types: 109, coercions: 4}
 *** CorePrep:
 Result size of CorePrep = {terms: 45, types: 157, coercions: 5}
 *** ByteCodeGen:
 Upsweep completely successful.
 *** Deleting temp files:
 Deleting: /tmp/ghc22446_0/ghc22446_2.c /tmp/ghc22446_0/ghc22446_1.o
 Warning: deleting non-existent /tmp/ghc22446_0/ghc22446_2.c
 Warning: deleting non-existent /tmp/ghc22446_0/ghc22446_1.o
 Ok, modules loaded: Main.
 *Main> f tmt
 *** Parser:
 *** Desugar:
 *** Simplify:
 *** CorePrep:
 *** ByteCodeGen:
 True
 *Main> :break 11
 Breakpoint 0 activated at DebuggerCrash2.hs:11:21-32
 *Main> f tmt
 *** Parser:
 *** Desugar:
 *** Simplify:
 *** CorePrep:
 *** ByteCodeGen:
 ghc-stage2: panic! (the 'impossible' happened)
   (GHC version 7.10.1 for x86_64-unknown-linux):
         ASSERT failed! file compiler/typecheck/TcType.hs line 730 k_an3
 }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/10617>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler


More information about the ghc-tickets mailing list