From 5279dda861f6a5cc804be88dc5f0ff2442660149 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Mon, 10 Jun 2019 09:25:57 -0400 Subject: PrelRules: Don't break let/app invariant in shiftRule Previously shiftRule would rewrite as invalid shift like ``` let x = I# (uncheckedIShiftL# n 80) in ... ``` to ``` let x = I# (error "invalid shift") in ... ``` However, this breaks the let/app invariant as `error` is not okay-for-speculation. There isn't an easy way to avoid this so let's not try. Instead we just take advantage of the undefined nature of invalid shifts and return zero. Fixes #16742. --- compiler/coreSyn/CoreSyn.hs | 3 +++ compiler/prelude/PrelRules.hs | 25 +++++++++++++++++++--- compiler/prelude/PrimOp.hs | 21 ++++++++++++++++++ testsuite/tests/codeGen/should_run/T16449_2.hs | 4 ++++ testsuite/tests/codeGen/should_run/T16449_2.stderr | 1 - testsuite/tests/codeGen/should_run/T16449_2.stdout | 2 ++ testsuite/tests/codeGen/should_run/all.T | 2 +- 7 files changed, 53 insertions(+), 5 deletions(-) delete mode 100644 testsuite/tests/codeGen/should_run/T16449_2.stderr create mode 100644 testsuite/tests/codeGen/should_run/T16449_2.stdout diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index f48fef568e..95b05392ae 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -445,6 +445,9 @@ which will generate a @case@ if necessary The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in coreSyn/MkCore. +For discussion of some implications of the let/app invariant primops see +Note [Checking versus non-checking primops] in PrimOp. + Note [CoreSyn type and coercion invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We allow a /non-recursive/, /non-top-level/ let to bind type and diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 6f77813785..6b93df5494 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -476,8 +476,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length " ++ show shift_len) + -> return $ Lit $ mkLitNumberWrap dflags LitNumInt 0 (exprType e1) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) @@ -702,7 +701,27 @@ can't constant fold it, but if it gets to the assember we get Error: operand type mismatch for `shl' So the best thing to do is to rewrite the shift with a call to error, -when the second arg is stupid. +when the second arg is large. However, in general we cannot do this; consider +this case + + let x = I# (uncheckedIShiftL# n 80) + in ... + +Here x contains an invalid shift and consequently we would like to rewrite it +as follows: + + let x = I# (error "invalid shift) + in ... + +This was originally done in the fix to #16449 but this breaks the let/app +invariant (see Note [CoreSyn let/app invariant] in CoreSyn) as noted in #16742. +For the reasons discussed in Note [Checking versus non-checking primops] (in +the PrimOp module) there is no safe way rewrite the argument of I# such that +it bottoms. + +Consequently we instead take advantage of the fact that large shifts are +undefined behavior (see associated documentation in primops.txt.pp) and +transform the invalid shift into an "obviously incorrect" value. There are two cases: diff --git a/compiler/prelude/PrimOp.hs b/compiler/prelude/PrimOp.hs index edadf15d4c..3e157aea9b 100644 --- a/compiler/prelude/PrimOp.hs +++ b/compiler/prelude/PrimOp.hs @@ -304,6 +304,27 @@ primOpOutOfLine :: PrimOp -> Bool * * ************************************************************************ +Note [Checking versus non-checking primops] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + In GHC primops break down into two classes: + + a. Checking primops behave, for instance, like division. In this + case the primop may throw an exception (e.g. division-by-zero) + and is consequently is marked with the can_fail flag described below. + The ability to fail comes at the expense of precluding some optimizations. + + b. Non-checking primops behavior, for instance, like addition. While + addition can overflow it does not produce an exception. So can_fail is + set to False, and we get more optimisation opportunities. But we must + never throw an exception, so we cannot rewrite to a call to error. + + It is important that a non-checking primop never be transformed in a way that + would cause it to bottom. Doing so would violate Core's let/app invariant + (see Note [CoreSyn let/app invariant] in CoreSyn) which is critical to + the simplifier's ability to float without fear of changing program meaning. + + Note [PrimOp can_fail and has_side_effects] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Both can_fail and has_side_effects mean that the primop has diff --git a/testsuite/tests/codeGen/should_run/T16449_2.hs b/testsuite/tests/codeGen/should_run/T16449_2.hs index 3424d43e25..acb885369c 100644 --- a/testsuite/tests/codeGen/should_run/T16449_2.hs +++ b/testsuite/tests/codeGen/should_run/T16449_2.hs @@ -5,5 +5,9 @@ module Main where import GHC.Prim import GHC.Int +-- Test that large unchecked shifts, which constitute undefined behavior, do +-- not crash the compiler and instead evaluate to 0. +-- See Note [Guarding against silly shifts] in PrelRules. + -- Shift should be larger than the word size (e.g. 64 on 64-bit) for this test. main = print (I# (uncheckedIShiftL# 1# 1000#)) diff --git a/testsuite/tests/codeGen/should_run/T16449_2.stderr b/testsuite/tests/codeGen/should_run/T16449_2.stderr deleted file mode 100644 index 869a5b0f91..0000000000 --- a/testsuite/tests/codeGen/should_run/T16449_2.stderr +++ /dev/null @@ -1 +0,0 @@ -T16449_2: Bad shift length 1000 diff --git a/testsuite/tests/codeGen/should_run/T16449_2.stdout b/testsuite/tests/codeGen/should_run/T16449_2.stdout new file mode 100644 index 0000000000..77ac542d4f --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T16449_2.stdout @@ -0,0 +1,2 @@ +0 + diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 5545c9ebb0..535ca8651e 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -196,4 +196,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) -test('T16449_2', [expect_broken_for(16742, ['dyn', 'ghci', 'optasm', 'threaded2']), exit_code(1)], compile_and_run, ['']) +test('T16449_2', exit_code(0), compile_and_run, ['']) -- cgit v1.2.1