diff options
| -rw-r--r-- | compiler/prelude/KnownUniques.hs | 9 | ||||
| -rw-r--r-- | testsuite/tests/unboxedsums/T14051.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/unboxedsums/T14051a.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/unboxedsums/all.T | 1 |
4 files changed, 23 insertions, 3 deletions
diff --git a/compiler/prelude/KnownUniques.hs b/compiler/prelude/KnownUniques.hs index 8f1b0b6347..60fa0e2435 100644 --- a/compiler/prelude/KnownUniques.hs +++ b/compiler/prelude/KnownUniques.hs @@ -79,7 +79,8 @@ knownUniqueName u = mkSumTyConUnique :: Arity -> Unique mkSumTyConUnique arity = - ASSERT(arity < 0xff) + ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the + -- alternative mkUnique 'z' (arity `shiftL` 8 .|. 0xfc) mkSumDataConUnique :: ConTagZ -> Arity -> Unique @@ -98,16 +99,18 @@ getUnboxedSumName n _ -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag) | tag == 0x0 = dataConName $ sumDataCon (alt + 1) arity + | tag == 0x1 + = getName $ dataConWrapId $ sumDataCon (alt + 1) arity | tag == 0x2 = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity | otherwise = pprPanic "getUnboxedSumName" (ppr n) where arity = n `shiftR` 8 - alt = (n .&. 0xff) `shiftR` 2 + alt = (n .&. 0xfc) `shiftR` 2 tag = 0x3 .&. n getRep tycon = - fromMaybe (pprPanic "getUnboxedSumName" (ppr tycon)) + fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon)) $ tyConRepName_maybe tycon -- Note [Uniques for tuple type and data constructors] diff --git a/testsuite/tests/unboxedsums/T14051.hs b/testsuite/tests/unboxedsums/T14051.hs new file mode 100644 index 0000000000..96662a946e --- /dev/null +++ b/testsuite/tests/unboxedsums/T14051.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE UnboxedSums #-} + +module Main where + +import T14051a + +main :: IO () +main = print $ case func () of + (# True | #) -> 123 + _ -> 321 diff --git a/testsuite/tests/unboxedsums/T14051a.hs b/testsuite/tests/unboxedsums/T14051a.hs new file mode 100644 index 0000000000..b88f70ea05 --- /dev/null +++ b/testsuite/tests/unboxedsums/T14051a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE UnboxedSums #-} + +module T14051a where + +func :: s -> (# Bool | Bool #) +func _ = (# True | #) diff --git a/testsuite/tests/unboxedsums/all.T b/testsuite/tests/unboxedsums/all.T index eea818b6f1..45723cb4f0 100644 --- a/testsuite/tests/unboxedsums/all.T +++ b/testsuite/tests/unboxedsums/all.T @@ -32,3 +32,4 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) # ['$MAKE -s --no-print-directory sum_api_annots']) test('UbxSumLevPoly', normal, compile, ['']) +test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) |