Simon Jakobi pushed to branch wip/sjakobi/elem-tests at Glasgow Haskell Compiler / GHC Commits: 8789f4a7 by Simon Jakobi at 2026-03-27T20:55:11+01:00 Add a test for `elem` fusion - - - - - 7 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/all.T Changes: ===================================== libraries/base/tests/perf/ElemFusionUnknownList.hs ===================================== @@ -0,0 +1,14 @@ +module ElemFusionUnknownList where + +-- These should fuse with producers over unknown list inputs at -O1 and -O2. +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]) ===================================== libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr ===================================== @@ -0,0 +1,80 @@ +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,128 @@ +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,12 @@ +module ElemNoFusion where + +import Data.List (sort) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty + +-- These should not fuse with elem, even at -O1 and -O2. +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/all.T ===================================== @@ -26,6 +26,34 @@ test('T17752_O2', '-O2 -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds', "sed -n '/^is[A-Za-z]*$/,/^$/p'"]) +test('ElemFusionUnknownList_O1', + [only_ways(['normal']), extra_files(['ElemFusionUnknownList.hs'])], + multimod_compile_filter, + ['ElemFusionUnknownList', + '-O1 -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds', + "sed -n '/^fusion[A-Za-z]*$/,/^$/p'"]) + +test('ElemFusionUnknownList_O2', + [only_ways(['normal']), extra_files(['ElemFusionUnknownList.hs'])], + multimod_compile_filter, + ['ElemFusionUnknownList', + '-O2 -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds', + "sed -n '/^fusion[A-Za-z]*$/,/^$/p'"]) + +test('ElemNoFusion_O1', + [only_ways(['normal']), extra_files(['ElemNoFusion.hs'])], + multimod_compile_filter, + ['ElemNoFusion', + '-O1 -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds', + "sed -n '/^noFusion[A-Za-z]*/,/^$/p'"]) + +test('ElemNoFusion_O2', + [only_ways(['normal']), extra_files(['ElemNoFusion.hs'])], + multimod_compile_filter, + ['ElemNoFusion', + '-O2 -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds', + "sed -n '/^noFusion[A-Za-z]*/,/^$/p'"]) + #-------------------------------------- # We don't expect the code in test to vary at all, but the variance is set to View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8789f4a7c3242c2ec8434cc7cf3da3ea... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8789f4a7c3242c2ec8434cc7cf3da3ea... You're receiving this email because of your account on gitlab.haskell.org.