Illtyped generated code with unsafeCoerce#, F# and -O

[Donald Bruce Stewart]

Hey guys,

The following (evil, yes) program compiles and works under ghc -Onot
using -fasm or -fvia-C, but fails to generated correct code under all
GHCs back to ghc-5.04.2 if I turn on -O. (It also works under ghci).

When working it runs and produces the following (correct) result:

    paprika$ ./a.out 
    7777.0
    (69,243,8,0)
    7777.0

However, if I turn on -O it fails to generate acceptable asm or C.

Am I right in thinking that all uses of unsafeCoerce# should never
cause type-incorrect C or asm code to be generated (no matter what evil
happens at runtime)?

Now, -dcore-lint is fine, but our shiny new 6.4 -dcmm-lint spots the
error :)

    Cmm lint error:
      in proc s2D4_ret
        in basic block c2F7
          in MachOp application: 
            7777.0 :: F32 & 255

Here's the result -O -fvia-C:

    paprika$ ghc-6.4 -no-recomp -fglasgow-exts -O -fvia-C t.hs
    /tmp/ghc5870.hc: In function `s2D4_ret':
    /tmp/ghc5870.hc:253: error: invalid operands to binary &
    /tmp/ghc5870.hc: In function `Main_lvl2_entry':
    /tmp/ghc5870.hc:412: error: invalid operands to binary &
    
  where relevant lines are:
     253:   _s2D8 = ((StgFloat)7777.0) & 0xff;
  and
     472:   _s2Dg = ((StgFloat)7777.0) & 0xff;

  There appears to be a missing (W_) cast (?).

And -O -fasm:

    paprika$ ghc-6.4 -no-recomp -fglasgow-exts -O -fasm t.hs
    /tmp/ghc7685.s: Assembler messages:
    /tmp/ghc7685.s:309: Error: bad register name `%st(-7)'
    /tmp/ghc7685.s:316: Error: bad register name `%fake0'
    /tmp/ghc7685.s:317: Error: bad register name `%fake0'
    /tmp/ghc7685.s:472: Error: bad register name `%st(-7)'

  the relevant lines are:
     309:         ffree %st(7) ; flds .Ln2GX ; fstp %st(-7)
     316:         movl 8(%ebp),%fake0
     317:         orl %eax,%fake0
     472:         ffree %st(7) ; flds .Ln2HH ; fstp %st(-7)

We get a similar result with ghc-6.2.2 (but of course don't have a
-dcore-lint pass to spot the type error ;)

    paprika$ ghc-6.2.2 -no-recomp -keep-tmp-files -fglasgow-exts -O
    -fasm t.hs   
    /tmp/ghc4107.s: Assembler messages:
    /tmp/ghc4107.s:278: Error: bad register name `%st(-7)'
    /tmp/ghc4107.s:675: Error: bad register name `%fake0'
    /tmp/ghc4107.s:676: Error: bad register name `%fake0'

    paprika$ ghc-6.2.2 -no-recomp -keep-tmp-files -fglasgow-exts -O
    -fvia-C t.hs 
    /tmp/ghc7876.hc: In function `Main_zdwg_entry':
    /tmp/ghc7876.hc:221: error: invalid operands to binary &

And even back to ghc-5.04.2:
    zywiec$ ghc-5.04.2 -O -fglasgow-exts -fvia-C  t.hs
    /tmp/ghc2973.hc: In function `Main_a_entry':
    /tmp/ghc2973.hc:27: invalid operands to binary &

    zywiec$ ghc-5.04.2 -O -fglasgow-exts -fasm  t.hs  
    /tmp/ghc2977.s: Assembler messages:
    /tmp/ghc2977.s:79: Error: bad register name `%st(-7)'
    /tmp/ghc2977.s:774: Error: bad register name `%fake0'
    /tmp/ghc2977.s:775: Error: bad register name `%fake0'
    /tmp/ghc2977.s:776: Error: bad register name `%fake0'
    /tmp/ghc2977.s:777: Error: bad register name `%fake0'

-- Don

And here's  the nefarious code:

import GHC.Word
import GHC.Float
import GHC.Base

import Data.Bits

main = let f  = 7777.0 
           f' = g f
           f''= g' f'
       in do putStrLn (show f) 
             putStrLn (show f')
             putStrLn (show f'')

g :: Float -> (Word8,Word8,Word8,Word8)
g (F# f) = 
        let w     = W32# (unsafeCoerce# f)
            w0    = fromIntegral  (w `shiftR` 24)
            w1    = fromIntegral ((w `shiftR` 16) .&. 0xff)
            w2    = fromIntegral ((w `shiftR` 8)  .&. 0xff)
            w3    = fromIntegral  (w .&. 0xff)
        in (w0,w1,w2,w3)
        
g' :: (Word8,Word8,Word8,Word8) -> Float
g' (w0,w1,w2,w3) =
        let (W32# w) = (fromIntegral w0 `shiftL` 24) .|.
                       (fromIntegral w1 `shiftL` 16) .|.
                       (fromIntegral w2 `shiftL`  8) .|.
                       (fromIntegral w3)
        in F# (unsafeCoerce# w)