#5689: The 'impossible' happened: type-inference succeeds somehow in code which
isn't type-safe
------------------------------+---------------------------------------------
 Reporter:  nicolast          |          Owner:                         
     Type:  bug               |         Status:  new                    
 Priority:  normal            |      Component:  Compiler (Type checker)
  Version:  7.0.4             |       Keywords:                         
       Os:  Unknown/Multiple  |   Architecture:  Unknown/Multiple       
  Failure:  None/Unknown      |       Testcase:                         
Blockedby:                    |       Blocking:                         
  Related:                    |  
------------------------------+---------------------------------------------
 While trying to figure out how Haskell handles OCaml's value restriction,
 I created some code which I thought shouldn't type-check.

 It did, though, and makes GHCi panic on execution, or makes GHC fail
 during compilation.

 Minor changes to the code makes it no longer type-check, as expected.

 Here's the code, including some comments which show when compilation does
 fail as expected:


 {{{
 {-# LANGUAGE ScopedTypeVariables #-}

 import Data.IORef

 main :: IO ()
 main = do
     (r :: IORef (t -> t)) <- newIORef id
     -- r <- newIORef i -- => Type-check error

     writeIORef r (\v -> if v then False else True)

     c <- readIORef r

     print $ c True

     print $ c 1234

     -- print $ c Nothing -- => Type-check error
     -- print $ c (1 :: Int) -- => Type-check error
 }}}

 When replacing the "print $ c 1234" line with one of the last 2 lines,
 type-checking fails.
 When removing the explicit type-annotation on 'r', type-checking fails
 when "print $ c 1234" is left in place.

 Here's the GHCi and GHC output:

 {{{
 Prelude> :load demo1.hs
 [1 of 1] Compiling Main             ( demo1.hs, interpreted )
 Ok, modules loaded: Main.
 *Main> main
 ghc: panic! (the 'impossible' happened)
   (GHC version 7.0.4 for x86_64-unknown-linux):
         nameModule $dNum{v ann}

 Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug
 }}}

 {{{
 $ ghc --make demo1.hs
 [1 of 1] Compiling Main             ( demo1.hs, demo1.o )
 ghc: panic! (the 'impossible' happened)
   (GHC version 7.0.4 for x86_64-unknown-linux):
         initC: srt_lbl

 Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug
 }}}

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

_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to