[Git][ghc/ghc][wip/sjakobi/elem-tests] Improve tests for `elem`

Simon Jakobi pushed to branch wip/sjakobi/elem-tests at Glasgow Haskell Compiler / GHC Commits: ae3037e9 by Simon Jakobi at 2026-04-01T14:50:34+02:00 Improve tests for `elem` * Improve T17752 by including the Core output in golden files, checking both -O1 and -O2. * Add tests for fusion and no-fusion cases. Fixes #27101. - - - - - 12 changed files: - + libraries/base/tests/perf/ElemFusionUnknownList.hs - + libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr - + libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr - + libraries/base/tests/perf/ElemNoFusion.hs - + libraries/base/tests/perf/ElemNoFusion_O1.stderr - + libraries/base/tests/perf/ElemNoFusion_O2.stderr - − libraries/base/tests/perf/Makefile - libraries/base/tests/perf/T17752.hs - − libraries/base/tests/perf/T17752.stdout - + libraries/base/tests/perf/T17752_O1.stderr - + libraries/base/tests/perf/T17752_O2.stderr - libraries/base/tests/perf/all.T Changes: ===================================== libraries/base/tests/perf/ElemFusionUnknownList.hs ===================================== @@ -0,0 +1,21 @@ +-- We expect `elem` to fuse with good producers such as `map`, `concatMap`, +-- and `filter`. +module ElemFusionUnknownList where + +fusionElemMap :: Int -> [Int] -> Bool +fusionElemMap x = elem x . map (+1) + +fusionNotElemMap :: Int -> [Int] -> Bool +fusionNotElemMap x = notElem x . map (+1) + +fusionElemConcatMap :: Int -> [Int] -> Bool +fusionElemConcatMap x = elem x . concatMap (\y -> [y + 1, y + 2]) + +fusionNotElemConcatMap :: Int -> [Int] -> Bool +fusionNotElemConcatMap x = notElem x . concatMap (\y -> [y + 1, y + 2]) + +fusionElemFilter :: Int -> [Int] -> Bool +fusionElemFilter x = elem x . filter odd + +fusionNotElemFilter :: Int -> [Int] -> Bool +fusionNotElemFilter x = notElem x . filter odd ===================================== libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr ===================================== @@ -0,0 +1,124 @@ +fusionNotElemFilter + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y ys -> + case y of { I# ipv -> + case remInt# ipv 2# of { + __DEFAULT -> + case x of { I# x1 -> + case ==# x1 ipv of { + __DEFAULT -> jump go1 ys; + 1# -> False + } + }; + 0# -> jump go1 ys + } + } + }; } in + jump go1 eta + +fusionElemFilter + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case y of { I# ipv -> + case remInt# ipv 2# of { + __DEFAULT -> + case x of { I# x1 -> + case ==# x1 ipv of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + }; + 0# -> jump go1 ys + } + } + }; } in + jump go1 eta + +fusionNotElemConcatMap + = \ x x1 -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y ys -> + case y of { I# x2 -> + case x of { I# x3 -> + case ==# x3 (+# x2 1#) of { + __DEFAULT -> + case ==# x3 (+# x2 2#) of { + __DEFAULT -> jump go1 ys; + 1# -> False + }; + 1# -> False + } + } + } + }; } in + jump go1 x1 + +fusionElemConcatMap + = \ x x1 -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case y of { I# x2 -> + case x of { I# x3 -> + case ==# x3 (+# x2 1#) of { + __DEFAULT -> + case ==# x3 (+# x2 2#) of { + __DEFAULT -> jump go1 ys; + 1# -> True + }; + 1# -> True + } + } + } + }; } in + jump go1 x1 + +fusionNotElemMap + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y ys -> + case x of { I# x1 -> + case y of { I# x2 -> + case ==# x1 (+# x2 1#) of { + __DEFAULT -> jump go1 ys; + 1# -> False + } + } + } + }; } in + jump go1 eta + +fusionElemMap + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case x of { I# x1 -> + case y of { I# x2 -> + case ==# x1 (+# x2 1#) of { + __DEFAULT -> jump go1 ys; + 1# -> True + } + } + } + }; } in + jump go1 eta + ===================================== libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr ===================================== @@ -0,0 +1,206 @@ +fusionNotElemFilter + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y ys -> + case y of { I# ipv -> + case remInt# ipv 2# of { + __DEFAULT -> + case x of { I# x1 -> + case ==# x1 ipv of { + __DEFAULT -> + joinrec { + go2 ds1 + = case ds1 of { + [] -> True; + : y1 ys1 -> + case y1 of { I# ipv1 -> + case remInt# ipv1 2# of { + __DEFAULT -> + case ==# x1 ipv1 of { + __DEFAULT -> jump go2 ys1; + 1# -> False + }; + 0# -> jump go2 ys1 + } + } + }; } in + jump go2 ys; + 1# -> False + } + }; + 0# -> jump go1 ys + } + } + }; } in + jump go1 eta + +fusionElemFilter + = \ x eta -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y ys -> + case y of { I# ipv -> + case remInt# ipv 2# of { + __DEFAULT -> + case x of { I# x1 -> + case ==# x1 ipv of { + __DEFAULT -> + joinrec { + go2 ds1 + = case ds1 of { + [] -> False; + : y1 ys1 -> + case y1 of { I# ipv1 -> + case remInt# ipv1 2# of { + __DEFAULT -> + case ==# x1 ipv1 of { + __DEFAULT -> jump go2 ys1; + 1# -> True + }; + 0# -> jump go2 ys1 + } + } + }; } in + jump go2 ys; + 1# -> True + } + }; + 0# -> jump go1 ys + } + } + }; } in + jump go1 eta + +fusionNotElemConcatMap + = \ x x1 -> + case x1 of { + [] -> True; + : y ys -> + case y of { I# x2 -> + case x of { I# x3 -> + case ==# x3 (+# x2 1#) of { + __DEFAULT -> + case ==# x3 (+# x2 2#) of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y1 ys1 -> + case y1 of { I# x4 -> + case ==# x3 (+# x4 1#) of { + __DEFAULT -> + case ==# x3 (+# x4 2#) of { + __DEFAULT -> jump go1 ys1; + 1# -> False + }; + 1# -> False + } + } + }; } in + jump go1 ys; + 1# -> False + }; + 1# -> False + } + } + } + } + +fusionElemConcatMap + = \ x x1 -> + case x1 of { + [] -> False; + : y ys -> + case y of { I# x2 -> + case x of { I# x3 -> + case ==# x3 (+# x2 1#) of { + __DEFAULT -> + case ==# x3 (+# x2 2#) of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y1 ys1 -> + case y1 of { I# x4 -> + case ==# x3 (+# x4 1#) of { + __DEFAULT -> + case ==# x3 (+# x4 2#) of { + __DEFAULT -> jump go1 ys1; + 1# -> True + }; + 1# -> True + } + } + }; } in + jump go1 ys; + 1# -> True + }; + 1# -> True + } + } + } + } + +fusionNotElemMap + = \ x eta -> + case eta of { + [] -> True; + : y ys -> + case x of { I# x1 -> + case y of { I# x2 -> + case ==# x1 (+# x2 1#) of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> True; + : y1 ys1 -> + case y1 of { I# x3 -> + case ==# x1 (+# x3 1#) of { + __DEFAULT -> jump go1 ys1; + 1# -> False + } + } + }; } in + jump go1 ys; + 1# -> False + } + } + } + } + +fusionElemMap + = \ x eta -> + case eta of { + [] -> False; + : y ys -> + case x of { I# x1 -> + case y of { I# x2 -> + case ==# x1 (+# x2 1#) of { + __DEFAULT -> + joinrec { + go1 ds + = case ds of { + [] -> False; + : y1 ys1 -> + case y1 of { I# x3 -> + case ==# x1 (+# x3 1#) of { + __DEFAULT -> jump go1 ys1; + 1# -> True + } + } + }; } in + jump go1 ys; + 1# -> True + } + } + } + } + ===================================== libraries/base/tests/perf/ElemNoFusion.hs ===================================== @@ -0,0 +1,14 @@ +-- As of March 2026, we don't expect `elem` to fuse with `sort` or `NonEmpty.toList`. +-- `elem` isn't even specialized, and performs dictionary-passing, but that may +-- change: #27096 +module ElemNoFusion where + +import Data.List (sort) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty + +noFusionElemNonEmptyToList :: Int -> NonEmpty Int -> Bool +noFusionElemNonEmptyToList x = elem x . NonEmpty.toList + +noFusionElemSort :: Int -> [Int] -> Bool +noFusionElemSort x = elem x . sort ===================================== libraries/base/tests/perf/ElemNoFusion_O1.stderr ===================================== @@ -0,0 +1,5 @@ +noFusionElemSort = \ x x1 -> elem $fEqInt x (actualSort gtInt x1) + +noFusionElemNonEmptyToList + = \ x x1 -> case x1 of { :| a1 as -> elem $fEqInt x (: a1 as) } + ===================================== libraries/base/tests/perf/ElemNoFusion_O2.stderr ===================================== @@ -0,0 +1,5 @@ +noFusionElemSort = \ x x1 -> elem $fEqInt x (actualSort gtInt x1) + +noFusionElemNonEmptyToList + = \ x x1 -> case x1 of { :| a1 as -> elem $fEqInt x (: a1 as) } + ===================================== libraries/base/tests/perf/Makefile deleted ===================================== @@ -1,15 +0,0 @@ -# This Makefile runs the tests using GHC's testsuite framework. It -# assumes the package is part of a GHC build tree with the testsuite -# installed in ../../../testsuite. - -TOP=../../../../testsuite -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - - -T17752: - '$(TEST_HC)' $(TEST_HC_OPTS) -O --make T17752 -rtsopts -ddump-simpl -ddump-to-file -dsuppress-uniques -dsuppress-all - # All occurrences of elem should be optimized away. - # For strings these should result in loops after inlining foldCString. - # For lists it should result in a case expression. - echo $$(grep -A4 "elem" T17752.dump-simpl) ===================================== libraries/base/tests/perf/T17752.hs ===================================== @@ -6,7 +6,7 @@ module T17752 where -- Should compile to a pattern match if the rules fire isElemList x = x `elem` ['a','b','c'] -isNotElemList x = x `elem` ['x','y','z'] +isNotElemList x = x `notElem` ['x','y','z'] isOneOfThese x = x `elem` [1,2,3,4,5::Int] isNotOneOfThese x = x `notElem` [1,2,3,4,5::Int] ===================================== libraries/base/tests/perf/T17752.stdout deleted ===================================== @@ -1,2 +0,0 @@ -[1 of 1] Compiling T17752 ( T17752.hs, T17752.o ) - ===================================== libraries/base/tests/perf/T17752_O1.stderr ===================================== @@ -0,0 +1,118 @@ +isElemList + = \ x -> + case x of { C# x1 -> + case x1 of { + __DEFAULT -> False; + 'a'# -> True; + 'b'# -> True; + 'c'# -> True + } + } + +isNotElemList + = \ x -> + case x of { C# x1 -> + case x1 of { + __DEFAULT -> True; + 'x'# -> False; + 'y'# -> False; + 'z'# -> False + } + } + +isOneOfThese + = \ x -> + case x of { I# x1 -> + case x1 of { + __DEFAULT -> False; + 1# -> True; + 2# -> True; + 3# -> True; + 4# -> True; + 5# -> True + } + } + +isNotOneOfThese + = \ x -> + case x of { I# x1 -> + case x1 of { + __DEFAULT -> True; + 1# -> False; + 2# -> False; + 3# -> False; + 4# -> False; + 5# -> False + } + } + +isElemString + = \ x -> + joinrec { + go addr z + = case indexCharOffAddr# addr 0# of ch { + __DEFAULT -> + case x of { C# x1 -> + case eqChar# x1 ch of { + __DEFAULT -> jump go (plusAddr# addr 1#) z; + 1# -> True + } + }; + '\NUL'# -> z + }; } in + jump go isElemString1 False + +isNotElemString + = \ x -> + joinrec { + go addr z + = case indexCharOffAddr# addr 0# of ch { + __DEFAULT -> + case x of { C# x1 -> + case eqChar# x1 ch of { + __DEFAULT -> jump go (plusAddr# addr 1#) z; + 1# -> False + } + }; + '\NUL'# -> + case z of { + False -> True; + True -> False + } + }; } in + jump go isNotElemString1 False + +isElemStringUtf + = \ x -> + unpackFoldrCStringUtf8# + isElemStringUtf1 + (\ y r -> + case x of { C# x1 -> + case y of { C# y1 -> + case eqChar# x1 y1 of { + __DEFAULT -> r; + 1# -> True + } + } + }) + False + +isNotElemStringUtf + = \ x -> + case unpackFoldrCStringUtf8# + isNotElemStringUtf1 + (\ y r -> + case x of { C# x1 -> + case y of { C# y1 -> + case eqChar# x1 y1 of { + __DEFAULT -> r; + 1# -> True + } + } + }) + False + of { + False -> True; + True -> False + } + ===================================== libraries/base/tests/perf/T17752_O2.stderr ===================================== @@ -0,0 +1,130 @@ +isElemList + = \ x -> + case x of { C# x1 -> + case x1 of { + __DEFAULT -> False; + 'a'# -> True; + 'b'# -> True; + 'c'# -> True + } + } + +isNotElemList + = \ x -> + case x of { C# x1 -> + case x1 of { + __DEFAULT -> True; + 'x'# -> False; + 'y'# -> False; + 'z'# -> False + } + } + +isOneOfThese + = \ x -> + case x of { I# x1 -> + case x1 of { + __DEFAULT -> False; + 1# -> True; + 2# -> True; + 3# -> True; + 4# -> True; + 5# -> True + } + } + +isNotOneOfThese + = \ x -> + case x of { I# x1 -> + case x1 of { + __DEFAULT -> True; + 1# -> False; + 2# -> False; + 3# -> False; + 4# -> False; + 5# -> False + } + } + +isElemString + = \ x -> + case indexCharOffAddr# isElemString1 0# of ch { + __DEFAULT -> + case x of { C# x1 -> + case eqChar# x1 ch of { + __DEFAULT -> + joinrec { + go addr z + = case indexCharOffAddr# addr 0# of ch1 { + __DEFAULT -> + case eqChar# x1 ch1 of { + __DEFAULT -> jump go (plusAddr# addr 1#) z; + 1# -> True + }; + '\NUL'# -> z + }; } in + jump go (plusAddr# isElemString1 1#) False; + 1# -> True + } + }; + '\NUL'# -> False + } + +isNotElemString + = \ x -> + case indexCharOffAddr# isNotElemString1 0# of ch { + __DEFAULT -> + case x of { C# x1 -> + case eqChar# x1 ch of { + __DEFAULT -> + joinrec { + $sgo sc + = case indexCharOffAddr# sc 0# of ch1 { + __DEFAULT -> + case eqChar# x1 ch1 of { + __DEFAULT -> jump $sgo (plusAddr# sc 1#); + 1# -> False + }; + '\NUL'# -> True + }; } in + jump $sgo (plusAddr# isNotElemString1 1#); + 1# -> False + } + }; + '\NUL'# -> True + } + +isElemStringUtf + = \ x -> + unpackFoldrCStringUtf8# + isElemStringUtf1 + (\ y r -> + case x of { C# x1 -> + case y of { C# y1 -> + case eqChar# x1 y1 of { + __DEFAULT -> r; + 1# -> True + } + } + }) + False + +isNotElemStringUtf + = \ x -> + case unpackFoldrCStringUtf8# + isNotElemStringUtf1 + (\ y r -> + case x of { C# x1 -> + case y of { C# y1 -> + case eqChar# x1 y1 of { + __DEFAULT -> r; + 1# -> True + } + } + }) + False + of { + False -> True; + True -> False + } + ===================================== libraries/base/tests/perf/all.T ===================================== @@ -2,10 +2,25 @@ setTestOpts(js_skip) #-------------------------------------- -# Check specialization of elem via rules +# Check optimization of `elem` #-------------------------------------- -test('T17752', [only_ways(['normal'])] , makefile_test, ['T17752']) +elemCoreFilter = "sed -En '/^(is|fusion|noFusion)[A-Za-z]*($| )/,/^$/p'" + +def elemCoreTest(test_name, module_name, opt): + test(test_name, + [only_ways(['normal']), extra_files([module_name + '.hs'])], + multimod_compile_filter, + [module_name, + f'{opt} -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds', + elemCoreFilter]) + +elemCoreTest('T17752_O1', 'T17752', '-O1') +elemCoreTest('T17752_O2', 'T17752', '-O2') +elemCoreTest('ElemFusionUnknownList_O1', 'ElemFusionUnknownList', '-O1') +elemCoreTest('ElemFusionUnknownList_O2', 'ElemFusionUnknownList', '-O2') +elemCoreTest('ElemNoFusion_O1', 'ElemNoFusion', '-O1') +elemCoreTest('ElemNoFusion_O2', 'ElemNoFusion', '-O2') #-------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae3037e90ed3f2a8f3eb17087fe034f0... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae3037e90ed3f2a8f3eb17087fe034f0... You're receiving this email because of your account on gitlab.haskell.org.