[GHC] #8383: "tagToEnum# (0# ==# 1#) :: Bool" causes CASEFAIL in ghci

[GHC]

#8383: "tagToEnum# (0# ==# 1#) :: Bool" causes CASEFAIL in ghci
---------------------------------+----------------------------------
        Reporter:  rwbarton      |            Owner:
            Type:  bug           |           Status:  new
        Priority:  normal        |        Milestone:
       Component:  GHCi          |          Version:  7.7
      Resolution:                |         Keywords:
Operating System:  Linux         |     Architecture:  x86_64 (amd64)
 Type of failure:  None/Unknown  |       Difficulty:  Unknown
       Test Case:                |       Blocked By:
        Blocking:                |  Related Tickets:
---------------------------------+----------------------------------

Comment (by rwbarton):

 {{{
 -- Compile code which expects an unboxed Int on the top of stack,
 -- (call it i), and pushes the i'th closure in the supplied list
 -- as a consequence.
 implement_tagToId :: [Name] -> BcM BCInstrList
 implement_tagToId names
    = ASSERT( notNull names )
      do labels <- getLabelsBc (genericLength names)
         label_fail <- getLabelBc
         label_exit <- getLabelBc
         let infos = zip4 labels (tail labels ++ [label_fail])
                                 [0 ..] names
             steps = map (mkStep label_exit) infos
         return (concatOL steps
                   `appOL`
                   toOL [LABEL label_fail, CASEFAIL, LABEL label_exit])
      where
         mkStep l_exit (my_label, next_label, n, name_for_n)
            = toOL [LABEL my_label,
                    TESTEQ_I n next_label,
                    PUSH_G name_for_n,
                    JMP l_exit]
 }}}

 This code is wrong, because `TESTEQ_I` expects a boxed Int on top of the
 stack.

 A silly but working fix is to `schemeT`:
 {{{
 #!diff
  schemeT d s p app

  --   | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False
  --   = panic "schemeT ?!?!"

  --   | trace ("\nschemeT\n" ++ showSDoc (pprCoreExpr (deAnnotate' app))
 ++ "\n") False
  --   = error "?!?!"

     -- Case 0
     | Just (arg, constr_names) <- maybe_is_tagToEnum_call
     = do (push, arg_words) <- pushAtom d p arg
          tagToId_sequence <- implement_tagToId constr_names
 -        return (push `appOL`  tagToId_sequence
 -                       `appOL`  mkSLIDE 1 (d - s + fromIntegral
 arg_words)
 +        return (push `appOL` push `appOL`  tagToId_sequence
 +                       `appOL`  mkSLIDE 1 (d - s + fromIntegral arg_words
 + 1)
                         `snocOL` ENTER)
 }}}

 Obviously, it would be more sensible to grab the actual info pointer for
 Int and push that instead of a second copy of the unboxed Int.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/8383#comment:2>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler