From e83af07e3d0b65fe6f37806e86d07f3e8dc1b01e Mon Sep 17 00:00:00 2001 From: David Feuer Date: Mon, 3 Apr 2017 22:25:55 -0400 Subject: Revert "Make raiseIO# produce topRes" This reverts commit da4687f63ffe5a6162e3d7856aa53de048dd0f42. It's not entirely trivial to clean up the dead code this patch introduced. In particular, when we see ``` case raiseIO# m s of s' -> e ``` we want to know that `e` is dead. For scrutinees that are properly bottom (which we don't want to consider `raiseIO# m s` to be, this is handled by rewriting `bot` to `case bot of {}`. But if we do that for `raiseIO#`, we end up with ``` case raiseIO# m s of {} ``` which looks a lot like bottom and could confuse demand analysis. I think we need to wait with this change until we have a more complete story. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3413 --- compiler/prelude/primops.txt.pp | 10 ++++++---- testsuite/tests/stranal/should_run/all.T | 2 +- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index c16bc74de2..8c936c6ac5 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -2019,9 +2019,11 @@ primop RaiseOp "raise#" GenPrimOp -- must be *precise* - we don't want the strictness analyser turning -- one kind of bottom into another, as it is allowed to do in pure code. -- --- We currently produce topRes, which is much too conservative (interfering --- with dead code elimination, unfortunately), but nothing else we currently --- have on tap is actually correct. +-- But we *do* want to know that it returns bottom after +-- being applied to two arguments, so that this function is strict in y +-- f x y | x>0 = raiseIO blah +-- | y>0 = return 1 +-- | otherwise = return 2 -- -- TODO Check that the above notes on @f@ are valid. The function successfully -- produces an IO exception when compiled without optimization. If we analyze @@ -2033,7 +2035,7 @@ primop RaiseOp "raise#" GenPrimOp primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topRes } + strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] exnRes } out_of_line = True has_side_effects = True diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index a07900bbbc..076474608e 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -14,4 +14,4 @@ test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm' test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) -test('T13380', exit_code(1), compile_and_run, ['']) +test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) -- cgit v1.2.1