[GHC] #14628: Panic (No skolem Info) in GHCi

#14628: Panic (No skolem Info) in GHCi -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: #13393 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Loading the following code in GHCi causes a panic. Versions affected at least 8.2.2 and 8.0.2 {{{ module Main where import System.IO import Control.Monad.IO.Class import Control.Monad.Trans.State import Text.Printf putArrayBytes :: Handle -- ^ output file handle -> [String] -- ^ byte-strings -> IO Int -- ^ total number of bytes written putArrayBytes outfile xs = do let writeCount x = modify' (+ length x) >> liftIO (putLine x) :: MonadIO m => StateT Int m () execStateT (mapM_ writeCount xs) 0 where putLine = hPutStrLn outfile . (" "++) . concatMap (printf "0x%02X,") {- ghci: :break 12 46 :trace putArrayBytes stdout [['1'..'9'],['2'..'8'],['3'..'7']] snd $ runStateT _result 0 -} main = undefined }}} {{{ Configuring GHCi with the following packages: GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( C:\test\test.hs, interpreted ) Ok, one module loaded. Loaded GHCi configuration from C:\Users\Andi\AppData\Local\Temp\ghci34988 \ghci-script *Main> :break 12 46 Breakpoint 0 activated at C:\test\test.hs:12:46-63 *Main> :trace putArrayBytes stdout [['1'..'9'],['2'..'8'],['3'..'7']] Stopped in Main.putArrayBytes.writeCount, C:\test\test.hs:12:46-63 _result :: StateT Int m () = _ putLine :: [Char] -> IO () = _ x :: [Char] = "123456789" [C:\test\test.hs:12:46-63] [C:\test\test.hs:12:46-63] *Main> snd $ runStateT _result 0 <interactive>:3:7: error:<interactive>: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-unknown-mingw32): No skolem info: m_I5Cm[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\typecheck\TcErrors.hs:2653:5 in ghc:TcErrors Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug [C:\test\test.hs:12:46-63] [C:\test\test.hs:12:46-63] *Main> :r [1 of 1] Compiling Main ( C:\test\test.hs, interpreted ) Ok, one module loaded. *Main> :break 12 46 Breakpoint 1 activated at C:\test\test.hs:12:46-63 *Main> :trace putArrayBytes stdout [['1'..'9'],['2'..'8'],['3'..'7']] Stopped in Main.putArrayBytes.writeCount, C:\test\test.hs:12:46-63 _result :: StateT Int m () = _ putLine :: [Char] -> IO () = _ x :: [Char] = "123456789" [C:\test\test.hs:12:46-63] [C:\test\test.hs:12:46-63] *Main> snd $ runStateT _result 0 <interactive>:7:7: error:<interactive>: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-unknown-mingw32): No skolem info: m_I5Nz[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\typecheck\TcErrors.hs:2653:5 in ghc:TcErrors Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug [C:\test\test.hs:12:46-63] [C:\test\test.hs:12:46-63] *Main> }}} Maybe related to #13393. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14628 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14628: Panic (No skolem Info) in GHCi -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => debugger -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14628#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14628: Panic (No skolem Info) in GHCi -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.2 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think it's unrelated to the fix for #13393. As you point out, this is debugger-land, and we have these `RuntimeUnk` skolems, which stand for as-yet-unknown types in the debugger. In this case `_result` has type {{{ _result :: StateT Int m_I4K0[rt] () }}} but the debugger can't figure out (by looking at the heap) what this `m_I4K0` type is. So when typechecking an expression involving `_result` we should complain if this `m` gets unified with anything. And it is when you try to evalute {{{ snd $ runStateT _result 0 }}} We get a wanted constraint {{{ [WD] hole{a4SP} :: (m_I4K0[rt] :: (* -> *)) ~# ((,) a_a4SI[tau:1] :: (* -> *)) }}} The trouble is that, in reporting the error, `TcErrors.getSkolemInfo` of course cannot find an enclosing implication constraint binding that `m`. What we should do instead is: * Make `getSkolemInfo` return a `SkolemInfo` rether than an `Implic` * If `getSkolemInfo` gets a `RuntimeUnk`, just return a new data constructor in `SkolemInfo`, perhpas `RuntimeUnkSkol`. * In `TcErrors.pprSkols` print something sensible for a `RuntimeUnkSkol` It'd be most helpful to look at the top-level type envt, and display some of the in-scope Ids that have that variale free in their types. The `relevantBindings` function might be good for finding such bindings. Any volunteers? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14628#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC