[GHC] #9035: ghci sometimes displays Word32 as Word64

#9035: ghci sometimes displays Word32 as Word64 --------------------------+------------------------------------------------ Reporter: | Owner: MikeIzbicki | Status: new Type: bug | Milestone: Priority: normal | Version: 7.8.2 Component: GHCi | Operating System: Linux Keywords: | Type of failure: Incorrect result at runtime Architecture: x86_64 | Test Case: (amd64) | Blocking: Difficulty: | Unknown | Blocked By: | Related Tickets: | --------------------------+------------------------------------------------ Given this code: {{{ module Main where import Data.Word import Unsafe.Coerce import System.IO nanFloat :: Float nanFloat = unsafeCoerce (maxBound :: Word32) float2word32 :: Float -> Word32 float2word32 = unsafeCoerce nanDouble :: Double nanDouble = unsafeCoerce (maxBound :: Word64) double2word64 :: Double -> Word64 double2word64 = unsafeCoerce main = do putStrLn $ "nanFloat = " ++ show (float2word32 nanFloat) putStrLn $ "nanFloat = " ++ show (float2word32 $ nanFloat + 1) putStrLn $ "nanDouble = " ++ show (double2word64 nanDouble) putStrLn $ "nanDouble = " ++ show (double2word64 $ nanDouble + 1) }}} If we compile with GHC and run, we correctly output: {{{ nanFloat = 4294967295 nanFloat = 4294967295 nanDouble = 18446744073709551615 nanDouble = 18446744073709551615 }}} But if we instead load in ghci, we get the following output: {{{ nanFloat = 4294967295 nanFloat = 140247862083583 nanDouble = 18446744073709551615 nanDouble = 18446744073709551615 }}} For some reason, ghci is displaying (nanFloat+1) as having significantly more digits than can possibly stored in a Word32 value. Test system: Intel Core 2 Duo running Debian with GHC 7.8.2 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9035 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9035: ghci sometimes displays Word32 as Word64 ------------------------------------------------+-------------------------- Reporter: MikeIzbicki | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.8.2 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Incorrect result at runtime | (amd64) Test Case: | Difficulty: Blocking: | Unknown | Blocked By: | Related Tickets: ------------------------------------------------+-------------------------- Comment (by hvr): Replying to [ticket:9035 MikeIzbicki]:
For some reason, ghci is displaying (nanFloat+1) as having significantly more digits than can possibly stored in a Word32 value.
Part of the reason is, that `Word32` is actually implemented as {{{#!haskell data Word32 = W32# Word# deriving (Eq, Ord) }}} and `Word#` is actually 64bit wide on the `x86_64` platform. So, `Word32` internally //can// actually store more digits than a 32-bit unsigned integer is supposed to hold. What I can't explain, though, is why a single-precision float, which should be 32bit wide, leaks into the hidden unused upper 32bit part of the `Float` (and thus also into the unsafely coerced `Word32`) heap object. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9035#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9035: ghci sometimes displays Word32 as Word64 ------------------------------------------------+-------------------------- Reporter: MikeIzbicki | Owner: Type: bug | Status: closed Priority: normal | Milestone: Component: GHCi | Version: 7.8.2 Resolution: invalid | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Incorrect result at runtime | (amd64) Test Case: | Difficulty: Blocking: | Unknown | Blocked By: | Related Tickets: ------------------------------------------------+-------------------------- Changes (by igloo): * status: new => closed * resolution: => invalid Comment: This use of `unsafeCoerce` is not safe: See [http://www.haskell.org/ghc/docs/latest/html/libraries/base-4.7.0.0 /Unsafe-Coerce.html this] which links to [http://www.haskell.org/ghc/docs/latest/html/libraries/ghc-prim-0.3.1.0 /GHC-Prim.html#v:unsafeCoerce-35- here] for more details. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9035#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9035: ghci sometimes displays Word32 as Word64 ------------------------------------------------+-------------------------- Reporter: MikeIzbicki | Owner: Type: bug | Status: closed Priority: normal | Milestone: Component: GHCi | Version: 7.8.2 Resolution: invalid | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Incorrect result at runtime | (amd64) Test Case: | Difficulty: Blocking: | Unknown | Blocked By: | Related Tickets: ------------------------------------------------+-------------------------- Comment (by MikeIzbicki): Replying to [comment:2 igloo]:
This use of `unsafeCoerce` is not safe: See [http://www.haskell.org/ghc/docs/latest/html/libraries/base-4.7.0.0 /Unsafe-Coerce.html this] which links to [http://www.haskell.org/ghc/docs/latest/html/libraries/ghc-prim-0.3.1.0 /GHC-Prim.html#v:unsafeCoerce-35- here] for more details.
I don't understand why it is incorrect. Is it because the float is boxed? We can easily change the code to: {{{ float2word32 :: Float -> Word32 float2word32 (F# f#) = W32# (unsafeCoerce# f#) }}} Now, we are casting between two unboxed types of the same size, which is explicitly allowed. The results, however, are exactly the same as before. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9035#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9035: ghci sometimes displays Word32 as Word64 ------------------------------------------------+-------------------------- Reporter: MikeIzbicki | Owner: Type: bug | Status: closed Priority: normal | Milestone: Component: GHCi | Version: 7.8.2 Resolution: invalid | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Incorrect result at runtime | (amd64) Test Case: | Difficulty: Blocking: | Unknown | Blocked By: | Related Tickets: ------------------------------------------------+-------------------------- Comment (by carter): you can't do an unsafe coerce between Words and Floats in ghc currently and have it be well defined . Its got nothing to do with boxing, it has to do with Floats and Words actually living is completely distinct groups of registers in the CPU. eg on x86, ghc currently only manipulates words in the general purpose registers, and floats are in SSE registers. (yes, there ARE word manipulation sse instructions, but ghc currently doesn't use them.. yet) NH2 wrote a cute wee lib to cast between float and words https://github.com/nh2/float-cast, which works by writing the input to memory as one type, and reading the memory location back as the other type. I think the only reason some of your code works at all is your unsafe coerce actually will by accident do that "casted memory read" off the heap. The other issue is your Word32 is actually going to be 64bit (1 whoel register) value on 64 bit systems, but Floats are always 32b bits, and your unsafe coerce doesn't actually have any well defined way of mapping between the two. Again, anything resembling that working in current GHC is actually a complete "this is undefined" accident :) -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9035#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9035: ghci sometimes displays Word32 as Word64 ------------------------------------------------+-------------------------- Reporter: MikeIzbicki | Owner: Type: bug | Status: closed Priority: normal | Milestone: Component: GHCi | Version: 7.8.2 Resolution: invalid | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Incorrect result at runtime | (amd64) Test Case: | Difficulty: Blocking: | Unknown | Blocked By: | Related Tickets: ------------------------------------------------+-------------------------- Comment (by MikeIzbicki): Ahh, I see. I missed the clause in the documentation that says you can't convert between floating point and integer types. I have a handful of code that needs fixing now :( Just for my own curiosity, I'd like to read the spot in GHC that prevents this particular usage of unsafeCoerce. Any idea which files I should look at? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9035#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9035: ghci sometimes displays Word32 as Word64 ------------------------------------------------+-------------------------- Reporter: MikeIzbicki | Owner: Type: bug | Status: closed Priority: normal | Milestone: Component: GHCi | Version: 7.8.2 Resolution: invalid | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Incorrect result at runtime | (amd64) Test Case: | Difficulty: Blocking: | Unknown | Blocked By: | Related Tickets: ------------------------------------------------+-------------------------- Comment (by simonpj): I think it would be a great idea for Core Lint to check for uses of `unsafeCoerce` that don't obey the rules. It won't catch all cases, of course, but it would have caught this one. Specficially, look for: * Coercions between lifted and unboxed types * Coercion between unboxed types of different sizes * Coercion between unboxed ints and floats. Would anyone like to make a patch for this? Anything that can be checked by Core Lint, should be checked! I'm afraid I don't know where to look for the reason for the int/float difficulty. I'd write a tiny function that exhibits the unsafe conversion and look the code it generates. Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9035#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC