[commit: ghc] master: Fix bytecode generator panic (8de6e13)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/8de6e13f9ef784750e502955fcb38d4a7e179727/ghc

>---------------------------------------------------------------

commit 8de6e13f9ef784750e502955fcb38d4a7e179727
Author: Seraphime Kirkovski <kirkseraph at gmail.com>
Date:   Wed Jul 20 09:47:23 2016 +0200

    Fix bytecode generator panic
    
    This fixes #12128.
    
    The bug was introduced in 1c9fd3f1c5522372fcaf250c805b959e8090a62c.
    
    Test Plan: ./validate
    
    Reviewers: simonmar, austin, hvr, simonpj, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: simonpj, thomie
    
    Differential Revision: https://phabricator.haskell.org/D2374
    
    GHC Trac Issues: #12128


>---------------------------------------------------------------

8de6e13f9ef784750e502955fcb38d4a7e179727
 compiler/ghci/ByteCodeGen.hs                  | 11 +++++++++++
 testsuite/tests/ghci/should_run/T12128.hs     | 14 ++++++++++++++
 testsuite/tests/ghci/should_run/T12128.script |  1 +
 testsuite/tests/ghci/should_run/all.T         |  1 +
 4 files changed, 27 insertions(+)

diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 0d4c64b..8839ffa 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -1327,6 +1327,12 @@ pushAtom d p e
 pushAtom _ _ (AnnCoercion {})   -- Coercions are zero-width things,
    = return (nilOL, 0)          -- treated just like a variable V
 
+-- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs
+-- and Note [Bottoming expressions] in coreSyn/CoreUtils.hs:
+-- The scrutinee of an empty case evaluates to bottom
+pushAtom d p (AnnCase (_, a) _ _ []) -- trac #12128
+   = pushAtom d p a
+
 pushAtom d p (AnnVar v)
    | UnaryRep rep_ty <- repType (idType v)
    , V <- typeArgRep rep_ty
@@ -1627,6 +1633,11 @@ atomPrimRep :: AnnExpr' Id ann -> PrimRep
 atomPrimRep e | Just e' <- bcView e = atomPrimRep e'
 atomPrimRep (AnnVar v)              = bcIdPrimRep v
 atomPrimRep (AnnLit l)              = typePrimRep (literalType l)
+
+-- Trac #12128:
+-- A case expresssion can be an atom because empty cases evaluate to bottom.
+-- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs
+atomPrimRep (AnnCase _ _ ty _)      = ASSERT(typePrimRep ty == PtrRep) PtrRep
 atomPrimRep (AnnCoercion {})        = VoidRep
 atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate' other))
 
diff --git a/testsuite/tests/ghci/should_run/T12128.hs b/testsuite/tests/ghci/should_run/T12128.hs
new file mode 100644
index 0000000..0194910
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T12128.hs
@@ -0,0 +1,14 @@
+{-
+    This code produces an empty case statement, which
+    panics the bytecode generator after trac #11155.
+-}
+
+module ShouldCompile where
+
+import GHC.TypeLits (Symbol)
+import Unsafe.Coerce
+
+instance Read Symbol where
+     readsPrec = unsafeCoerce (readsPrec :: Int -> ReadS String)
+
+data Bar = TyCon !Symbol deriving (Read)
diff --git a/testsuite/tests/ghci/should_run/T12128.script b/testsuite/tests/ghci/should_run/T12128.script
new file mode 100644
index 0000000..8873ce2
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T12128.script
@@ -0,0 +1 @@
+:load T12128
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index 08fe33d..f7e5018 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -24,3 +24,4 @@ test('T10145',     just_ghci, ghci_script, ['T10145.script'])
 test('T7253',      just_ghci, ghci_script, ['T7253.script'])
 test('T11328',     just_ghci, ghci_script, ['T11328.script'])
 test('T11825',     just_ghci, ghci_script, ['T11825.script'])
+test('T12128',     just_ghci, ghci_script, ['T12128.script'])