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 Fix bytecode generation for `tagToEnum# <LITERAL>` Fixes #25975. - - - - - 4 changed files: - compiler/GHC/StgToByteCode.hs - + testsuite/tests/bytecode/T25975.hs - + testsuite/tests/bytecode/T25975.stdout - testsuite/tests/bytecode/all.T Changes: ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1801,10 +1801,14 @@ maybe_getCCallReturnRep fn_ty _ -> pprPanic "maybe_getCCallReturn: can't handle:" (pprType fn_ty) -maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (Id, [Name]) +maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (StgArg, [Name]) -- Detect and extract relevant info for the tagToEnum kludge. -maybe_is_tagToEnum_call (StgOpApp (StgPrimOp TagToEnumOp) [StgVarArg v] t) +maybe_is_tagToEnum_call (StgOpApp (StgPrimOp TagToEnumOp) args t) + | [v] <- args = Just (v, extract_constr_Names t) + | otherwise + = pprPanic "StgToByteCode: tagToEnum#" + $ text "Expected exactly one arg, but actual args are:" <+> ppr args where extract_constr_Names ty | rep_ty <- unwrapType ty @@ -1851,13 +1855,13 @@ implement_tagToId :: StackDepth -> Sequel -> BCEnv - -> Id + -> StgArg -> [Name] -> BcM BCInstrList -- See Note [Implementing tagToEnum#] implement_tagToId d s p arg names = assert (notNull names) $ - do (push_arg, arg_bytes) <- pushAtom d p (StgVarArg arg) + do (push_arg, arg_bytes) <- pushAtom d p arg labels <- getLabelsBc (strictGenericLength names) label_fail <- getLabelBc label_exit <- getLabelBc ===================================== testsuite/tests/bytecode/T25975.hs ===================================== @@ -0,0 +1,27 @@ +-- Tests bytecode generation for tagToEnum# applied to literals +{-# LANGUAGE MagicHash #-} +module Main (main) where + +import GHC.Exts + +f1 :: Int# -> Bool +{-# OPAQUE f1 #-} +f1 v = case v of + 4# -> tagToEnum# v + _ -> False + +f2 :: Int# -> Bool +{-# OPAQUE f2 #-} +f2 v = case v of + 5# -> tagToEnum# 6# + _ -> True + +f3 :: Ordering +f3 = tagToEnum# (noinline runRW# (\_ -> 1#)) + + +main :: IO () +main = do + print $ f1 2# + print $ f2 3# + print f3 ===================================== testsuite/tests/bytecode/T25975.stdout ===================================== @@ -0,0 +1,3 @@ +False +True +EQ ===================================== testsuite/tests/bytecode/all.T ===================================== @@ -1,3 +1,7 @@ ghci_dump_bcos = [only_ways(['ghci']), extra_run_opts('-dno-typeable-binds -dsuppress-uniques -ddump-bcos')] test('T23068', ghci_dump_bcos + [filter_stdout_lines(r'.*bitmap: .*')], ghci_script, ['T23068.script']) + +test('T25975', extra_ways(ghci_ways), compile_and_run, + # Some of the examples work more robustly with these flags + ['-fno-break-points -fno-full-laziness']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6cb3e990906148813038a3158076746b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6cb3e990906148813038a3158076746b... You're receiving this email because of your account on gitlab.haskell.org.