Matthew Craven pushed to branch wip/T25975 at Glasgow Haskell Compiler / GHC
Commits:
-
6cb3e990
by Matthew Craven at 2025-04-18T08:31:11-04:00
4 changed files:
- compiler/GHC/StgToByteCode.hs
- + testsuite/tests/bytecode/T25975.hs
- + testsuite/tests/bytecode/T25975.stdout
- testsuite/tests/bytecode/all.T
Changes:
| ... | ... | @@ -1801,10 +1801,14 @@ maybe_getCCallReturnRep fn_ty |
| 1801 | 1801 | _ -> pprPanic "maybe_getCCallReturn: can't handle:"
|
| 1802 | 1802 | (pprType fn_ty)
|
| 1803 | 1803 | |
| 1804 | -maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (Id, [Name])
|
|
| 1804 | +maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (StgArg, [Name])
|
|
| 1805 | 1805 | -- Detect and extract relevant info for the tagToEnum kludge.
|
| 1806 | -maybe_is_tagToEnum_call (StgOpApp (StgPrimOp TagToEnumOp) [StgVarArg v] t)
|
|
| 1806 | +maybe_is_tagToEnum_call (StgOpApp (StgPrimOp TagToEnumOp) args t)
|
|
| 1807 | + | [v] <- args
|
|
| 1807 | 1808 | = Just (v, extract_constr_Names t)
|
| 1809 | + | otherwise
|
|
| 1810 | + = pprPanic "StgToByteCode: tagToEnum#"
|
|
| 1811 | + $ text "Expected exactly one arg, but actual args are:" <+> ppr args
|
|
| 1808 | 1812 | where
|
| 1809 | 1813 | extract_constr_Names ty
|
| 1810 | 1814 | | rep_ty <- unwrapType ty
|
| ... | ... | @@ -1851,13 +1855,13 @@ implement_tagToId |
| 1851 | 1855 | :: StackDepth
|
| 1852 | 1856 | -> Sequel
|
| 1853 | 1857 | -> BCEnv
|
| 1854 | - -> Id
|
|
| 1858 | + -> StgArg
|
|
| 1855 | 1859 | -> [Name]
|
| 1856 | 1860 | -> BcM BCInstrList
|
| 1857 | 1861 | -- See Note [Implementing tagToEnum#]
|
| 1858 | 1862 | implement_tagToId d s p arg names
|
| 1859 | 1863 | = assert (notNull names) $
|
| 1860 | - do (push_arg, arg_bytes) <- pushAtom d p (StgVarArg arg)
|
|
| 1864 | + do (push_arg, arg_bytes) <- pushAtom d p arg
|
|
| 1861 | 1865 | labels <- getLabelsBc (strictGenericLength names)
|
| 1862 | 1866 | label_fail <- getLabelBc
|
| 1863 | 1867 | label_exit <- getLabelBc
|
| 1 | +-- Tests bytecode generation for tagToEnum# applied to literals
|
|
| 2 | +{-# LANGUAGE MagicHash #-}
|
|
| 3 | +module Main (main) where
|
|
| 4 | + |
|
| 5 | +import GHC.Exts
|
|
| 6 | + |
|
| 7 | +f1 :: Int# -> Bool
|
|
| 8 | +{-# OPAQUE f1 #-}
|
|
| 9 | +f1 v = case v of
|
|
| 10 | + 4# -> tagToEnum# v
|
|
| 11 | + _ -> False
|
|
| 12 | + |
|
| 13 | +f2 :: Int# -> Bool
|
|
| 14 | +{-# OPAQUE f2 #-}
|
|
| 15 | +f2 v = case v of
|
|
| 16 | + 5# -> tagToEnum# 6#
|
|
| 17 | + _ -> True
|
|
| 18 | + |
|
| 19 | +f3 :: Ordering
|
|
| 20 | +f3 = tagToEnum# (noinline runRW# (\_ -> 1#))
|
|
| 21 | + |
|
| 22 | + |
|
| 23 | +main :: IO ()
|
|
| 24 | +main = do
|
|
| 25 | + print $ f1 2#
|
|
| 26 | + print $ f2 3#
|
|
| 27 | + print f3 |
| 1 | +False
|
|
| 2 | +True
|
|
| 3 | +EQ |
| 1 | 1 | ghci_dump_bcos = [only_ways(['ghci']), extra_run_opts('-dno-typeable-binds -dsuppress-uniques -ddump-bcos')]
|
| 2 | 2 | |
| 3 | 3 | test('T23068', ghci_dump_bcos + [filter_stdout_lines(r'.*bitmap: .*')], ghci_script, ['T23068.script'])
|
| 4 | + |
|
| 5 | +test('T25975', extra_ways(ghci_ways), compile_and_run,
|
|
| 6 | + # Some of the examples work more robustly with these flags
|
|
| 7 | + ['-fno-break-points -fno-full-laziness']) |