diff options
Diffstat (limited to 'testsuite/tests')
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T18603.hs | 29 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 1 |
2 files changed, 30 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_compile/T18603.hs b/testsuite/tests/simplCore/should_compile/T18603.hs new file mode 100644 index 0000000000..d85f77c66a --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T18603.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Test where + +import GHC.Base (build, foldr, id, Maybe(..)) + +catMaybes :: [Maybe a] -> [a] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe b) -> [a] -> [b] +mapMaybe _ [] = [] +mapMaybe f (x:xs) = + let rs = mapMaybe f xs in + case f x of + Nothing -> rs + Just r -> r:rs +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# INLINE [0] mapMaybeFB #-} -- See Note [Inline FB functions] in GHC.List +mapMaybeFB :: (b -> r -> r) -> (a -> Maybe b) -> a -> r -> r +mapMaybeFB cons f x next = case f x of + Nothing -> next + Just r -> cons r next diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index d377cfd06b..1535e32253 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -333,6 +333,7 @@ test('T18347', normal, compile, ['-dcore-lint -O']) test('T18355', [ grep_errmsg(r'OneShot') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T18399', normal, compile, ['-dcore-lint -O']) test('T18589', normal, compile, ['-dcore-lint -O']) +test('T18603', normal, compile, ['-dcore-lint -O']) # T18649 should /not/ generate a specialisation rule test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) |