Fix bytecode generator panic
authorSeraphime Kirkovski <kirkseraph@gmail.com>
Wed, 20 Jul 2016 07:47:23 +0000 (09:47 +0200)
committerBen Gamari <ben@smart-cactus.org>
Wed, 20 Jul 2016 13:17:50 +0000 (15:17 +0200)
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

compiler/ghci/ByteCodeGen.hs
testsuite/tests/ghci/should_run/T12128.hs [new file with mode: 0644]
testsuite/tests/ghci/should_run/T12128.script [new file with mode: 0644]
testsuite/tests/ghci/should_run/all.T

index 0d4c64b..8839ffa 100644 (file)
@@ -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 (file)
index 0000000..0194910
--- /dev/null
@@ -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 (file)
index 0000000..8873ce2
--- /dev/null
@@ -0,0 +1 @@
+:load T12128
index 08fe33d..f7e5018 100644 (file)
@@ -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'])