[Git][ghc/ghc][master] 4 commits: Add quotRem rules (#22152)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Apr 13 12:50:53 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00
Add quotRem rules (#22152)
case quotRemInt# x y of
(# q, _ #) -> body
====>
case quotInt# x y of
q -> body
case quotRemInt# x y of
(# _, r #) -> body
====>
case remInt# x y of
r -> body
- - - - -
4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00
Add quot folding rule (#22152)
(x / l1) / l2
l1 and l2 /= 0
l1*l2 doesn't overflow
==> x / (l1 * l2)
- - - - -
1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00
Make Int64/Word64 division ok for speculation too.
Only when the divisor is definitely non-zero.
- - - - -
8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00
Make WordQuotRem2Op ok-for-speculation too
- - - - -
10 changed files:
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Types/Literal.hs
- + testsuite/tests/primops/should_compile/T22152.hs
- + testsuite/tests/primops/should_compile/T22152.stderr
- + testsuite/tests/primops/should_compile/T22152b.hs
- + testsuite/tests/primops/should_compile/T22152b.stderr
- testsuite/tests/primops/should_compile/all.T
Changes:
=====================================
compiler/GHC/Builtin/PrimOps.hs
=====================================
@@ -551,36 +551,43 @@ primOpIsCheap op = primOpOkForSpeculation op
primOpIsDiv :: PrimOp -> Bool
primOpIsDiv op = case op of
- -- TODO: quotRemWord2, Int64, Word64
IntQuotOp -> True
Int8QuotOp -> True
Int16QuotOp -> True
Int32QuotOp -> True
+ Int64QuotOp -> True
IntRemOp -> True
Int8RemOp -> True
Int16RemOp -> True
Int32RemOp -> True
+ Int64RemOp -> True
IntQuotRemOp -> True
Int8QuotRemOp -> True
Int16QuotRemOp -> True
Int32QuotRemOp -> True
+ -- Int64QuotRemOp doesn't exist (yet)
WordQuotOp -> True
Word8QuotOp -> True
Word16QuotOp -> True
Word32QuotOp -> True
+ Word64QuotOp -> True
WordRemOp -> True
Word8RemOp -> True
Word16RemOp -> True
Word32RemOp -> True
+ Word64RemOp -> True
WordQuotRemOp -> True
Word8QuotRemOp -> True
Word16QuotRemOp -> True
Word32QuotRemOp -> True
+ -- Word64QuotRemOp doesn't exist (yet)
+
+ WordQuotRem2Op -> True
FloatDivOp -> True
DoubleDivOp -> True
=====================================
compiler/GHC/Core/Opt/ConstantFold.hs
=====================================
@@ -27,6 +27,7 @@ module GHC.Core.Opt.ConstantFold
( primOpRules
, builtinRules
, caseRules
+ , caseRules2
)
where
@@ -120,7 +121,9 @@ primOpRules nm = \case
Int8QuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int8Op2 quot)
, leftZero
, rightIdentity oneI8
- , equalArgs $> Lit oneI8 ]
+ , equalArgs $> Lit oneI8
+ , quotFoldingRules int8Ops
+ ]
Int8RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int8Op2 rem)
, leftZero
, oneLit 1 $> Lit zeroI8
@@ -149,7 +152,9 @@ primOpRules nm = \case
, mulFoldingRules Word8MulOp word8Ops
]
Word8QuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word8Op2 quot)
- , rightIdentity oneW8 ]
+ , rightIdentity oneW8
+ , quotFoldingRules word8Ops
+ ]
Word8RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word8Op2 rem)
, leftZero
, oneLit 1 $> Lit zeroW8
@@ -194,7 +199,9 @@ primOpRules nm = \case
Int16QuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int16Op2 quot)
, leftZero
, rightIdentity oneI16
- , equalArgs $> Lit oneI16 ]
+ , equalArgs $> Lit oneI16
+ , quotFoldingRules int16Ops
+ ]
Int16RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int16Op2 rem)
, leftZero
, oneLit 1 $> Lit zeroI16
@@ -223,7 +230,9 @@ primOpRules nm = \case
, mulFoldingRules Word16MulOp word16Ops
]
Word16QuotOp-> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word16Op2 quot)
- , rightIdentity oneW16 ]
+ , rightIdentity oneW16
+ , quotFoldingRules word16Ops
+ ]
Word16RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word16Op2 rem)
, leftZero
, oneLit 1 $> Lit zeroW16
@@ -268,7 +277,9 @@ primOpRules nm = \case
Int32QuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int32Op2 quot)
, leftZero
, rightIdentity oneI32
- , equalArgs $> Lit oneI32 ]
+ , equalArgs $> Lit oneI32
+ , quotFoldingRules int32Ops
+ ]
Int32RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int32Op2 rem)
, leftZero
, oneLit 1 $> Lit zeroI32
@@ -297,7 +308,9 @@ primOpRules nm = \case
, mulFoldingRules Word32MulOp word32Ops
]
Word32QuotOp-> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word32Op2 quot)
- , rightIdentity oneW32 ]
+ , rightIdentity oneW32
+ , quotFoldingRules word32Ops
+ ]
Word32RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word32Op2 rem)
, leftZero
, oneLit 1 $> Lit zeroW32
@@ -341,7 +354,9 @@ primOpRules nm = \case
Int64QuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int64Op2 quot)
, leftZero
, rightIdentity oneI64
- , equalArgs $> Lit oneI64 ]
+ , equalArgs $> Lit oneI64
+ , quotFoldingRules int64Ops
+ ]
Int64RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int64Op2 rem)
, leftZero
, oneLit 1 $> Lit zeroI64
@@ -370,7 +385,9 @@ primOpRules nm = \case
, mulFoldingRules Word64MulOp word64Ops
]
Word64QuotOp-> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word64Op2 quot)
- , rightIdentity oneW64 ]
+ , rightIdentity oneW64
+ , quotFoldingRules word64Ops
+ ]
Word64RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word64Op2 rem)
, leftZero
, oneLit 1 $> Lit zeroW64
@@ -451,7 +468,9 @@ primOpRules nm = \case
IntQuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 quot)
, leftZero
, rightIdentityPlatform onei
- , equalArgs >> retLit onei ]
+ , equalArgs >> retLit onei
+ , quotFoldingRules intOps
+ ]
IntRemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 rem)
, leftZero
, oneLit 1 >> retLit zeroi
@@ -503,7 +522,9 @@ primOpRules nm = \case
, mulFoldingRules WordMulOp wordOps
]
WordQuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 quot)
- , rightIdentityPlatform onew ]
+ , rightIdentityPlatform onew
+ , quotFoldingRules wordOps
+ ]
WordRemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 rem)
, leftZero
, oneLit 1 >> retLit zerow
@@ -2652,6 +2673,14 @@ orFoldingRules num_ops = do
(orFoldingRules' platform arg1 arg2 num_ops
<|> orFoldingRules' platform arg2 arg1 num_ops)
+quotFoldingRules :: NumOps -> RuleM CoreExpr
+quotFoldingRules num_ops = do
+ env <- getRuleOpts
+ guard (roNumConstantFolding env)
+ [arg1,arg2] <- getArgs
+ platform <- getPlatform
+ liftMaybe (quotFoldingRules' platform arg1 arg2 num_ops)
+
addFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
addFoldingRules' platform arg1 arg2 num_ops = case (arg1, arg2) of
@@ -2942,6 +2971,29 @@ orFoldingRules' platform arg1 arg2 num_ops = case (arg1, arg2) of
mkL = Lit . mkNumLiteral platform num_ops
or x y = BinOpApp x (fromJust (numOr num_ops)) y
+quotFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
+quotFoldingRules' platform arg1 arg2 num_ops = case (arg1, arg2) of
+
+ -- (x / l1) / l2
+ -- l1 and l2 /= 0
+ -- l1*l2 doesn't overflow
+ -- ==> x / (l1 * l2)
+ (is_div num_ops -> Just (x, L l1), L l2)
+ | l1 /= 0
+ , l2 /= 0
+ -- check that the result of the multiplication is in range
+ , Just l <- mkNumLiteralMaybe platform num_ops (l1 * l2)
+ -> Just (div x (Lit l))
+ -- NB: we could directly return 0 or (-1) in case of overflow,
+ -- but we would need to know
+ -- (1) if we're dealing with a quot or a div operation
+ -- (2) if it's an underflow or an overflow.
+ -- Left as future work for now.
+
+ _ -> Nothing
+ where
+ div x y = BinOpApp x (fromJust (numDiv num_ops)) y
+
is_binop :: PrimOp -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)
is_binop op e = case e of
BinOpApp x op' y | op == op' -> Just (x,y)
@@ -2952,12 +3004,13 @@ is_op op e = case e of
App (OpVal op') x | op == op' -> Just x
_ -> Nothing
-is_add, is_sub, is_mul, is_and, is_or :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)
+is_add, is_sub, is_mul, is_and, is_or, is_div :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)
is_add num_ops e = is_binop (numAdd num_ops) e
is_sub num_ops e = is_binop (numSub num_ops) e
is_mul num_ops e = is_binop (numMul num_ops) e
is_and num_ops e = numAnd num_ops >>= \op -> is_binop op e
is_or num_ops e = numOr num_ops >>= \op -> is_binop op e
+is_div num_ops e = numDiv num_ops >>= \op -> is_binop op e
is_neg :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr)
is_neg num_ops e = numNeg num_ops >>= \op -> is_op op e
@@ -3006,6 +3059,7 @@ data NumOps = NumOps
{ numAdd :: !PrimOp -- ^ Add two numbers
, numSub :: !PrimOp -- ^ Sub two numbers
, numMul :: !PrimOp -- ^ Multiply two numbers
+ , numDiv :: !(Maybe PrimOp) -- ^ Divide two numbers
, numAnd :: !(Maybe PrimOp) -- ^ And two numbers
, numOr :: !(Maybe PrimOp) -- ^ Or two numbers
, numNeg :: !(Maybe PrimOp) -- ^ Negate a number
@@ -3016,15 +3070,20 @@ data NumOps = NumOps
mkNumLiteral :: Platform -> NumOps -> Integer -> Literal
mkNumLiteral platform ops i = mkLitNumberWrap platform (numLitType ops) i
+-- | Create a numeric literal if it is in range
+mkNumLiteralMaybe :: Platform -> NumOps -> Integer -> Maybe Literal
+mkNumLiteralMaybe platform ops i = mkLitNumberMaybe platform (numLitType ops) i
+
int8Ops :: NumOps
int8Ops = NumOps
{ numAdd = Int8AddOp
, numSub = Int8SubOp
, numMul = Int8MulOp
- , numLitType = LitNumInt8
+ , numDiv = Just Int8QuotOp
, numAnd = Nothing
, numOr = Nothing
, numNeg = Just Int8NegOp
+ , numLitType = LitNumInt8
}
word8Ops :: NumOps
@@ -3032,6 +3091,7 @@ word8Ops = NumOps
{ numAdd = Word8AddOp
, numSub = Word8SubOp
, numMul = Word8MulOp
+ , numDiv = Just Word8QuotOp
, numAnd = Just Word8AndOp
, numOr = Just Word8OrOp
, numNeg = Nothing
@@ -3043,10 +3103,11 @@ int16Ops = NumOps
{ numAdd = Int16AddOp
, numSub = Int16SubOp
, numMul = Int16MulOp
- , numLitType = LitNumInt16
+ , numDiv = Just Int16QuotOp
, numAnd = Nothing
, numOr = Nothing
, numNeg = Just Int16NegOp
+ , numLitType = LitNumInt16
}
word16Ops :: NumOps
@@ -3054,6 +3115,7 @@ word16Ops = NumOps
{ numAdd = Word16AddOp
, numSub = Word16SubOp
, numMul = Word16MulOp
+ , numDiv = Just Word16QuotOp
, numAnd = Just Word16AndOp
, numOr = Just Word16OrOp
, numNeg = Nothing
@@ -3065,10 +3127,11 @@ int32Ops = NumOps
{ numAdd = Int32AddOp
, numSub = Int32SubOp
, numMul = Int32MulOp
- , numLitType = LitNumInt32
+ , numDiv = Just Int32QuotOp
, numAnd = Nothing
, numOr = Nothing
, numNeg = Just Int32NegOp
+ , numLitType = LitNumInt32
}
word32Ops :: NumOps
@@ -3076,6 +3139,7 @@ word32Ops = NumOps
{ numAdd = Word32AddOp
, numSub = Word32SubOp
, numMul = Word32MulOp
+ , numDiv = Just Word32QuotOp
, numAnd = Just Word32AndOp
, numOr = Just Word32OrOp
, numNeg = Nothing
@@ -3087,10 +3151,11 @@ int64Ops = NumOps
{ numAdd = Int64AddOp
, numSub = Int64SubOp
, numMul = Int64MulOp
- , numLitType = LitNumInt64
+ , numDiv = Just Int64QuotOp
, numAnd = Nothing
, numOr = Nothing
, numNeg = Just Int64NegOp
+ , numLitType = LitNumInt64
}
word64Ops :: NumOps
@@ -3098,6 +3163,7 @@ word64Ops = NumOps
{ numAdd = Word64AddOp
, numSub = Word64SubOp
, numMul = Word64MulOp
+ , numDiv = Just Word64QuotOp
, numAnd = Just Word64AndOp
, numOr = Just Word64OrOp
, numNeg = Nothing
@@ -3109,6 +3175,7 @@ intOps = NumOps
{ numAdd = IntAddOp
, numSub = IntSubOp
, numMul = IntMulOp
+ , numDiv = Just IntQuotOp
, numAnd = Just IntAndOp
, numOr = Just IntOrOp
, numNeg = Just IntNegOp
@@ -3120,6 +3187,7 @@ wordOps = NumOps
{ numAdd = WordAddOp
, numSub = WordSubOp
, numMul = WordMulOp
+ , numDiv = Just WordQuotOp
, numAnd = Just WordAndOp
, numOr = Just WordOrOp
, numNeg = Nothing
@@ -3192,6 +3260,61 @@ caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x
caseRules _ _ = Nothing
+-- | Case rules
+--
+-- It's important that occurence info are present, hence the use of In* types.
+caseRules2
+ :: InExpr -- ^ Scutinee
+ -> InId -- ^ Case-binder
+ -> [InAlt] -- ^ Alternatives in standard (increasing) order
+ -> Maybe (InExpr, InId, [InAlt])
+caseRules2 scrut bndr alts
+
+ -- case quotRem# x y of
+ -- (# q, _ #) -> body
+ -- ====>
+ -- case quot# x y of
+ -- q -> body
+ --
+ -- case quotRem# x y of
+ -- (# _, r #) -> body
+ -- ====>
+ -- case rem# x y of
+ -- r -> body
+ | BinOpApp x op y <- scrut
+ , Just (quot,rem) <- is_any_quot_rem op
+ , [Alt (DataAlt _) [q,r] body] <- alts
+ , isDeadBinder bndr
+ , dead_q <- isDeadBinder q
+ , dead_r <- isDeadBinder r
+ , dead_q || dead_r
+ = if
+ | dead_q -> Just $ (BinOpApp x rem y, r, [Alt DEFAULT [] body])
+ | dead_r -> Just $ (BinOpApp x quot y, q, [Alt DEFAULT [] body])
+ | otherwise -> Nothing
+
+ | otherwise
+ = Nothing
+
+
+-- | If the given primop is a quotRem, return the corresponding (quot,rem).
+is_any_quot_rem :: PrimOp -> Maybe (PrimOp, PrimOp)
+is_any_quot_rem = \case
+ IntQuotRemOp -> Just (IntQuotOp , IntRemOp)
+ Int8QuotRemOp -> Just (Int8QuotOp, Int8RemOp)
+ Int16QuotRemOp -> Just (Int16QuotOp, Int16RemOp)
+ Int32QuotRemOp -> Just (Int32QuotOp, Int32RemOp)
+ -- Int64QuotRemOp doesn't exist (yet)
+
+ WordQuotRemOp -> Just (WordQuotOp, WordRemOp)
+ Word8QuotRemOp -> Just (Word8QuotOp, Word8RemOp)
+ Word16QuotRemOp -> Just (Word16QuotOp, Word16RemOp)
+ Word32QuotRemOp -> Just (Word32QuotOp, Word32RemOp)
+ -- Word64QuotRemOp doesn't exist (yet)
+
+ _ -> Nothing
+
+
tx_lit_con :: Platform -> (Integer -> Integer) -> AltCon -> Maybe AltCon
tx_lit_con _ _ DEFAULT = Just DEFAULT
tx_lit_con platform adjust (LitAlt l) = Just $ LitAlt (mapLitValue platform adjust l)
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -19,6 +19,7 @@ import GHC.Driver.Flags
import GHC.Core
import GHC.Core.Opt.Simplify.Monad
+import GHC.Core.Opt.ConstantFold
import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst )
import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.Opt.Simplify.Env
@@ -3039,6 +3040,14 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont
; case mb_rule of
Just (env', rule_rhs, cont') -> simplExprF env' rule_rhs cont'
Nothing -> reallyRebuildCase env scrut case_bndr alts cont }
+
+--------------------------------------------------
+-- 3. Primop-related case-rules
+--------------------------------------------------
+
+ |Just (scrut', case_bndr', alts') <- caseRules2 scrut case_bndr alts
+ = reallyRebuildCase env scrut' case_bndr' alts' cont
+
where
all_dead_bndrs = all isDeadBinder bndrs -- bndrs are [InId]
is_plain_seq = all_dead_bndrs && isDeadBinder case_bndr -- Evaluation *only* for effect
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -1615,8 +1615,10 @@ app_ok fun_ok primop_ok fun args
PrimOpId op _
| primOpIsDiv op
- , [arg1, Lit lit] <- args
- -> not (isZeroLit lit) && expr_ok fun_ok primop_ok arg1
+ , Lit divisor <- last args
+ -- there can be 2 args (most div primops) or 3 args
+ -- (WordQuotRem2Op), hence the use of last/init
+ -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (init args)
-- Special case for dividing operations that fail
-- In general they are NOT ok-for-speculation
-- (which primop_ok will catch), but they ARE OK
=====================================
compiler/GHC/Types/Literal.hs
=====================================
@@ -32,7 +32,7 @@ module GHC.Types.Literal
, mkLitFloat, mkLitDouble
, mkLitChar, mkLitString
, mkLitBigNat
- , mkLitNumber, mkLitNumberWrap
+ , mkLitNumber, mkLitNumberWrap, mkLitNumberMaybe
-- ** Operations on Literals
, literalType
@@ -411,6 +411,12 @@ mkLitNumber platform nt i =
assertPpr (litNumCheckRange platform nt i) (integer i)
(LitNumber nt i)
+-- | Create a numeric 'Literal' of the given type if it is in range
+mkLitNumberMaybe :: Platform -> LitNumType -> Integer -> Maybe Literal
+mkLitNumberMaybe platform nt i
+ | litNumCheckRange platform nt i = Just (LitNumber nt i)
+ | otherwise = Nothing
+
-- | Creates a 'Literal' of type @Int#@
mkLitInt :: Platform -> Integer -> Literal
mkLitInt platform x = assertPpr (platformInIntRange platform x) (integer x)
=====================================
testsuite/tests/primops/should_compile/T22152.hs
=====================================
@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques #-}
+module T22152 (toHours) where
+
+{-# INLINE toHoursMinutesSeconds #-}
+toHoursMinutesSeconds :: Int -> (Int, Int, Int)
+toHoursMinutesSeconds t = (h, m', s)
+ where
+ (h, m') = m `quotRem` 60
+ (m, s) = toMinutesSeconds t
+
+toMinutesSeconds :: Int -> (Int, Int)
+toMinutesSeconds t = t `quotRem` 60
+
+toHours t = h
+ where
+ (h, _, _) = toHoursMinutesSeconds t
=====================================
testsuite/tests/primops/should_compile/T22152.stderr
=====================================
@@ -0,0 +1,9 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 9, types: 5, coercions: 0, joins: 0/0}
+
+toHours = \ t -> case t of { I# x -> I# (quotInt# x 3600#) }
+
+
+
=====================================
testsuite/tests/primops/should_compile/T22152b.hs
=====================================
@@ -0,0 +1,38 @@
+{-# OPTIONS_GHC -O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques #-}
+module T22152b where
+
+import Data.Int
+import Data.Word
+
+a :: Int32 -> Int32
+a x = (x `quot` maxBound) `quot` maxBound -- overflow, mustn't trigger the rewrite rule
+
+b :: Int -> Int
+b x = (x `quot` 10) `quot` 20
+
+c :: Word -> Word
+c x = (x `quot` 10) `quot` 20
+
+d :: Word8 -> Word8
+d x = (x `quot` 10) `quot` 20
+
+e :: Word16 -> Word16
+e x = (x `quot` 10) `quot` 20
+
+f :: Word32 -> Word32
+f x = (x `quot` 10) `quot` 20
+
+g :: Word64 -> Word64
+g x = (x `quot` 10) `quot` 20
+
+h :: Int8 -> Int8
+h x = (x `quot` 10) `quot` 20
+
+i :: Int16 -> Int16
+i x = (x `quot` 10) `quot` 20
+
+j :: Int32 -> Int32
+j x = (x `quot` 10) `quot` 20
+
+k :: Int64 -> Int64
+k x = (x `quot` 10) `quot` 20
=====================================
testsuite/tests/primops/should_compile/T22152b.stderr
=====================================
@@ -0,0 +1,38 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 103, types: 55, coercions: 0, joins: 0/0}
+
+b = \ x -> case x of { I# x1 -> I# (quotInt# x1 200#) }
+
+c = \ x -> case x of { W# x# -> W# (quotWord# x# 200##) }
+
+d = \ x -> case x of { W8# x# -> W8# (quotWord8# x# 200#Word8) }
+
+e = \ x ->
+ case x of { W16# x# -> W16# (quotWord16# x# 200#Word16) }
+
+f = \ x ->
+ case x of { W32# x# -> W32# (quotWord32# x# 200#Word32) }
+
+g = \ x ->
+ case x of { W64# x# -> W64# (quotWord64# x# 200#Word64) }
+
+h = \ x ->
+ case x of { I8# x# ->
+ I8# (quotInt8# (quotInt8# x# 10#Int8) 20#Int8)
+ }
+
+i = \ x -> case x of { I16# x# -> I16# (quotInt16# x# 200#Int16) }
+
+j = \ x -> case x of { I32# x# -> I32# (quotInt32# x# 200#Int32) }
+
+a = \ x ->
+ case x of { I32# x# ->
+ I32# (quotInt32# (quotInt32# x# 2147483647#Int32) 2147483647#Int32)
+ }
+
+k = \ x -> case x of { I64# x# -> I64# (quotInt64# x# 200#Int64) }
+
+
+
=====================================
testsuite/tests/primops/should_compile/all.T
=====================================
@@ -6,3 +6,5 @@ test('LevAddrToAny', normal, compile, [''])
test('UnliftedMutVar_Comp', normal, compile, [''])
test('UnliftedStableName', normal, compile, [''])
test('KeepAliveWrapper', normal, compile, ['-O'])
+test('T22152', normal, compile, [''])
+test('T22152b', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/690d0225d297a8c5c423ec4e63ee709df9d96d47...8af401ccfbe28d7bbfc493c0097834e9c66a36b0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/690d0225d297a8c5c423ec4e63ee709df9d96d47...8af401ccfbe28d7bbfc493c0097834e9c66a36b0
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/20230413/9ed6c184/attachment-0001.html>
More information about the ghc-commits
mailing list