[Git][ghc/ghc][wip/T16742] 2 commits: Allow runtimeError applications under let/app invariant
Ben Gamari
gitlab at gitlab.haskell.org
Tue Jun 4 03:45:29 UTC 2019
Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC
Commits:
1b50fdcb by Ben Gamari at 2019-06-04T03:44:27Z
Allow runtimeError applications under let/app invariant
PrelRules.shiftRule can now rewrite Int# expressions to bottom due to
the invalid-shift check introduced by
1503da32d26fb59fb6ebb620bfd0f8c08638f627. To accomodate this we allow
known-bottoming expressions under the let/app invariant.
- - - - -
80203523 by Ben Gamari at 2019-06-04T03:44:27Z
PrelRules: Ensure that shift rule result type is correct
Previously shiftRule would always produce a wordPrimTy result, despite
the fact that some of the primops which it handled were of type
intPrimTy.
- - - - -
3 changed files:
- compiler/coreSyn/CoreLint.hs
- compiler/coreSyn/CoreSyn.hs
- compiler/prelude/PrelRules.hs
Changes:
=====================================
compiler/coreSyn/CoreLint.hs
=====================================
@@ -536,7 +536,8 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
; checkL ( isJoinId binder
|| not (isUnliftedType binder_ty)
|| (isNonRec rec_flag && exprOkForSpeculation rhs)
- || exprIsTickedString rhs)
+ || exprIsTickedString rhs
+ )
(badBndrTyMsg binder (text "unlifted"))
-- Check that if the binder is top-level or recursive, it's not
@@ -1018,7 +1019,7 @@ lintCoreArg fun_ty arg
(ppr arg <+> dcolon <+> parens (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))))
-- check for levity polymorphism first, because otherwise isUnliftedType panics
- ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg)
+ ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg || exprIsBottom arg)
(mkLetAppMsg arg)
; lintValApp arg fun_ty arg_ty }
=====================================
compiler/coreSyn/CoreSyn.hs
=====================================
@@ -420,9 +420,9 @@ parts of the compilation pipeline.
Note [CoreSyn let/app invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The let/app invariant
- the right hand side of a non-recursive 'Let', and
- the argument of an 'App',
+The let/app invariant:
+ the right hand side of a non-recursive 'Let', and
+ the argument of an 'App',
/may/ be of unlifted type, but only if
the expression is ok-for-speculation
or the 'Let' is for a join point.
@@ -445,6 +445,14 @@ which will generate a @case@ if necessary
The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in
coreSyn/MkCore.
+One notable exception to this rule is bottoming expressions. For instance, we
+allow
+
+ y::Int = I# (runtimeError ...)
+
+since we sometimes need to make unlifted bindings bottom (e.g. see
+PrelRules.shiftRule).
+
Note [CoreSyn type and coercion invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We allow a /non-recursive/, /non-top-level/ let to bind type and
=====================================
compiler/prelude/PrelRules.hs
=====================================
@@ -134,11 +134,11 @@ primOpRules nm NotIOp = mkPrimOpRule nm 1 [ unaryLit complementOp
, inversePrimOp NotIOp ]
primOpRules nm IntNegOp = mkPrimOpRule nm 1 [ unaryLit negOp
, inversePrimOp IntNegOp ]
-primOpRules nm ISllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL)
+primOpRules nm ISllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) intPrimTy
, rightIdentityDynFlags zeroi ]
-primOpRules nm ISraOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR)
+primOpRules nm ISraOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR) intPrimTy
, rightIdentityDynFlags zeroi ]
-primOpRules nm ISrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical
+primOpRules nm ISrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical intPrimTy
, rightIdentityDynFlags zeroi ]
-- Word operations
@@ -180,8 +180,8 @@ primOpRules nm XorOp = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)
, equalArgs >> retLit zerow ]
primOpRules nm NotOp = mkPrimOpRule nm 1 [ unaryLit complementOp
, inversePrimOp NotOp ]
-primOpRules nm SllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ]
-primOpRules nm SrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ]
+primOpRules nm SllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) wordPrimTy ]
+primOpRules nm SrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical wordPrimTy ]
-- coercions
primOpRules nm Word2IntOp = mkPrimOpRule nm 1 [ liftLitDynFlags word2IntLit
@@ -462,12 +462,12 @@ wordOpC2 op dflags (LitNumber LitNumWord w1 _) (LitNumber LitNumWord w2 _) =
wordCResult dflags (fromInteger w1 `op` fromInteger w2)
wordOpC2 _ _ _ _ = Nothing -- Could find LitLit
-shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr
+shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> Type -> RuleM CoreExpr
-- Shifts take an Int; hence third arg of op is Int
-- Used for shift primops
-- ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word#
-- SllOp, SrlOp :: Word# -> Int# -> Word#
-shiftRule shift_op
+shiftRule shift_op resultTy
= do { dflags <- getDynFlags
; [e1, Lit (LitNumber LitNumInt shift_len _)] <- getArgs
; case e1 of
@@ -475,7 +475,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
+ -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID resultTy
("Bad shift length " ++ show shift_len)
-- Do the shift at type Integer, but shift length is Int
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3c44d90954a64d83217f300e6508a21f13ccbb70...802035236788df8168345c84b10fb012ef1c21df
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3c44d90954a64d83217f300e6508a21f13ccbb70...802035236788df8168345c84b10fb012ef1c21df
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190603/b529e8f7/attachment-0001.html>
More information about the ghc-commits
mailing list