[GHC] #14828: panic! when using :print on some functions with class constraints?
GHC
ghc-devs at haskell.org
Mon Mar 4 18:42:14 UTC 2019
#14828: panic! when using :print on some functions with class constraints?
-------------------------------------+-------------------------------------
Reporter: jol | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone:
Component: GHCi | Version: 8.2.2
Resolution: | Keywords: debugger
Operating System: Linux | Architecture: x86_64
Type of failure: Compile-time | (amd64)
crash or panic | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by RyanGlScott):
I spent some time today digging into why exactly this panic happens. The
immediate issue appears to be a hiccup in how the interactive debugger
handles higher-rank types, which is surprising, considering that none of
the types in the original description appear to be higher-rank. For the
time being, just take my word for it that this is true—I'll return to this
point later.
Here is an example showing that `:print` chokes on a term with a higher-
rank type:
{{{
GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help
Loaded GHCi configuration from /home/rgscott/.ghci
λ> f :: (forall a. a -> a) -> b -> b; f g x = g x
λ> :print f
ghc: panic! (the 'impossible' happened)
(GHC version 8.2.2 for x86_64-unknown-linux):
isUnliftedType
t1_a1tY[rt] :: TYPE t_a1tX[rt]
Call stack:
CallStack (from HasCallStack):
prettyCurrentCallStack, called at
compiler/utils/Outputable.hs:1133:58 in ghc:Outputable
callStackDoc, called at compiler/utils/Outputable.hs:1137:37 in
ghc:Outputable
pprPanic, called at compiler/types/Type.hs:1952:10 in ghc:Type
}}}
The fact that the panic mentions `t1_a1tY` is a bit curious... I wonder
what happens if we try an older version of GHC?
{{{
GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help
Loaded GHCi configuration from /home/rgscott/.ghci
λ> f :: (forall a. a -> a) -> b -> b; f g x = g x
λ> :print f
f = (_t1::t1)
}}}
Ah, this //doesn't// panic on GHC 8.0, so this must be a regression
introduced between 8.0 and 8.2. Moreover, note that even in 8.0, `:print
f`'s behavior is strange: it prints out a thunk of type `t1` instead of,
say, `(forall a. a -> a) -> b -> b`. This must explain where the `t1_a1tY`
in the 8.2 panic comes from, since that is the type of `_t1` (with its
unique explicitly printed).
What changed between GHC 8.0 and 8.2 that would trigger this panic? As it
turns out, it's commit e7985ed23ddc68b6a2e4af753578dc1d9e8ab4c9 (` Update
levity polymorphism`). Specifically,
[https://gitlab.haskell.org/ghc/ghc/commit/e7985ed23dd#7cf100051b3d8b0e1a0d4f723a9675e6c1540405
this change]:
{{{#!diff
diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 64ac1540aa..4d7f8e3ef0 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -28,7 +28,6 @@ import Var hiding ( varName )
import VarSet
import UniqFM
import Type
-import Kind
import GHC
import Outputable
import PprTyThing
@@ -78,7 +77,7 @@ pprintClosureCommand bindThings force str = do
term_ <- GHC.obtainTermFromId maxBound force id'
term <- tidyTermTyVars term_
term' <- if bindThings &&
- False == isUnliftedTypeKind (termType term)
+ (not (isUnliftedType (termType term)))
then bindSuspensions term
else return term
-- Before leaving, we compare the type obtained to see if it's more
specific
}}}
I'm not sure if this was Richard's intention, but this patch actually
changes the behavior of `:print`. Unlike `isUnlifedTypeKind`,
`isUnliftedType` is a partial function. If `isUnliftedType` cannot
ascertain with 100% confidence that a type is unlifted, then it throws the
`isUnliftedType` panic we saw above. Evidently, GHC isn't 100% confident
that `t1_a1tY` is unlifted.
This proposes one possible patch. Instead of checking if `not
(isUnliftedType (termType term))` returns `True`, we could check is
`isLiftedType_maybe (termType term)` returns `Just True`. This "inverts"
the check by querying if GHC is 100% certain that `termType term` is
//lifted//, and moreover, `isLiftedType_maybe` won't panic if that isn't
the case.
-----
So why are functions like `fmap`, which appear not to be higher-rank,
trigger this panic? `-ddump-rtti` reveals the answer:
{{{
GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help
Loaded GHCi configuration from /home/rgscott/.ghci
λ> :set -ddump-rtti
λ> :print fmap
Term reconstruction started with initial type forall (f :: * -> *).
GHC.Base.Functor f =>
forall a b. (a -> b) -> f a
-> f b
Unknown closure: Fun
check2 passed
add constraint: t1_a1sK[tau:1] =
GHC.Base.Functor f0_a1sI[tau:1] =>
forall a b. (a -> b) -> f0_a1sI[tau:1] a -> f0_a1sI[tau:1]
b
Term reconstruction completed.
Term obtained: _
Type obtained: t1_a1sK[rt]
ghc: panic! (the 'impossible' happened)
(GHC version 8.2.2 for x86_64-unknown-linux):
isUnliftedType
t1_a1sK[rt] :: TYPE t_a1sJ[rt]
Call stack:
CallStack (from HasCallStack):
prettyCurrentCallStack, called at
compiler/utils/Outputable.hs:1133:58 in ghc:Outputable
callStackDoc, called at compiler/utils/Outputable.hs:1137:37 in
ghc:Outputable
pprPanic, called at compiler/types/Type.hs:1952:10 in ghc:Type
}}}
In particular, take special notice of these parts:
{{{
Term reconstruction started with initial type forall (f :: * -> *).
GHC.Base.Functor f =>
forall a b. (a -> b) -> f a
-> f b
}}}
{{{
add constraint: t1_a1sK[tau:1] =
GHC.Base.Functor f0_a1sI[tau:1] =>
forall a b. (a -> b) -> f0_a1sI[tau:1] a -> f0_a1sI[tau:1]
b
}}}
`:print` starts with the type `forall f. Functor f => forall a b. (a -> b)
-> f a -> f b` which, strictly speaking, is higher-rank, as there is a
nested use of `forall a b`. Normally, we don't think of `forall`s to the
right of `=>` as higher-rank, since we can "float" them out to the front
of the type, but `:print` doesn't appear to be doing this, since the `add
constraint` logging message says that `t1_a1sK` is equal to `Functor f0 =>
forall a b. (a -> b) -> f0 a -> f0 b`, where `f0` is a metavariable. Note
that `:print` seems to have instantiated `f` with a metavariable, but not
`a` or `b`! If `:print` had done that, then `t1_a1sK` would not be higher-
rank at all, avoiding this panic in the first place.
Of course, even if we did this smarter metavariable instantiation, the
problem of higher-rank types crashing `:print` would still linger. This
suggests that we should fix the `isUnliftedType` panic first, and then we
can worry about future steps like making the type of `fmap` render
correctly with `:print`.
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14828#comment:4>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list