diff options
author | CarrieMY <carrie.xmy@gmail.com> | 2021-08-28 23:34:33 +0800 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-09-13 09:35:07 -0400 |
commit | 7bfa895547734e7c4ef10a19399da6d1f4968d8e (patch) | |
tree | 50b68787376be5b0e21d882140170c2c04b83481 | |
parent | 2d15175266d0e0d9ca6565124b0c17e207b5541c (diff) | |
download | haskell-7bfa895547734e7c4ef10a19399da6d1f4968d8e.tar.gz |
Fix #20203 improve constant fold for `and`/`or`
This patch follows the rules specified in note [Constant folding through
nested expressions]. Modifications are summarized below.
- Added andFoldingRules, orFoldingRules to primOpRules under those
xxxxAndOp, xxxxOrOp
- Refactored some helper functions
- Modify data NumOps to include two fields: numAnd and numOr
Resolves: #20203
See also: #19204
-rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 138 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_run/T20203.hs | 64 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_run/T20203.stderr-ws-32 | 153 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_run/T20203.stderr-ws-64 | 138 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_run/all.T | 1 |
5 files changed, 476 insertions, 18 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 35df78e5a7..3d5fd4ed0f 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -78,7 +78,7 @@ import Data.Functor (($>)) import qualified Data.ByteString as BS import Data.Ratio import Data.Word -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, fromJust) {- Note [Constant folding] @@ -158,11 +158,13 @@ primOpRules nm = \case , idempotent , zeroElem , sameArgIdempotentCommut Word8AndOp + , andFoldingRules word8Ops ] Word8OrOp -> mkPrimOpRule nm 2 [ binaryLit (word8Op2 (.|.)) , idempotent , identity zeroW8 , sameArgIdempotentCommut Word8OrOp + , orFoldingRules word8Ops ] Word8XorOp -> mkPrimOpRule nm 2 [ binaryLit (word8Op2 xor) , identity zeroW8 @@ -229,11 +231,13 @@ primOpRules nm = \case , idempotent , zeroElem , sameArgIdempotentCommut Word16AndOp + , andFoldingRules word16Ops ] Word16OrOp -> mkPrimOpRule nm 2 [ binaryLit (word16Op2 (.|.)) , idempotent , identity zeroW16 , sameArgIdempotentCommut Word16OrOp + , orFoldingRules word16Ops ] Word16XorOp -> mkPrimOpRule nm 2 [ binaryLit (word16Op2 xor) , identity zeroW16 @@ -300,11 +304,13 @@ primOpRules nm = \case , idempotent , zeroElem , sameArgIdempotentCommut Word32AndOp + , andFoldingRules word32Ops ] Word32OrOp -> mkPrimOpRule nm 2 [ binaryLit (word32Op2 (.|.)) , idempotent , identity zeroW32 , sameArgIdempotentCommut Word32OrOp + , orFoldingRules word32Ops ] Word32XorOp -> mkPrimOpRule nm 2 [ binaryLit (word32Op2 xor) , identity zeroW32 @@ -370,11 +376,13 @@ primOpRules nm = \case , idempotent , zeroElem , sameArgIdempotentCommut Word64AndOp + , andFoldingRules word64Ops ] Word64OrOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (.|.)) , idempotent , identity zeroW64 , sameArgIdempotentCommut Word64OrOp + , orFoldingRules word64Ops ] Word64XorOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 xor) , identity zeroW64 @@ -416,11 +424,13 @@ primOpRules nm = \case , idempotent , zeroElem , sameArgIdempotentCommut IntAndOp + , andFoldingRules intOps ] IntOrOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.)) , idempotent , identityPlatform zeroi , sameArgIdempotentCommut IntOrOp + , orFoldingRules intOps ] IntXorOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 xor) , identityPlatform zeroi @@ -465,11 +475,13 @@ primOpRules nm = \case , idempotent , zeroElem , sameArgIdempotentCommut WordAndOp + , andFoldingRules wordOps ] WordOrOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.)) , idempotent , identityPlatform zerow , sameArgIdempotentCommut WordOrOp + , orFoldingRules wordOps ] WordXorOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor) , identityPlatform zerow @@ -2506,8 +2518,8 @@ match_inline _ = Nothing -- B: (10+x) + 5 ==> 15+x -- C: (5+a)-(5-b) ==> 0+(a+b) -- --- R2) * simplification --- ops = *, two literals (not siblings) +-- R2) *, `and`, `or` simplification +-- ops = *, `and`, `or` two literals (not siblings) -- -- Examples: -- A: 5 * (10*x) ==> 50*x @@ -2591,6 +2603,27 @@ mulFoldingRules op num_ops = do (mulFoldingRules' platform arg1 arg2 num_ops <|> mulFoldingRules' platform arg2 arg1 num_ops) +andFoldingRules :: NumOps -> RuleM CoreExpr +andFoldingRules num_ops = do + env <- getRuleOpts + guard (roNumConstantFolding env) + [arg1,arg2] <- getArgs + platform <- getPlatform + liftMaybe + -- commutativity for `and` is handled here + (andFoldingRules' platform arg1 arg2 num_ops + <|> andFoldingRules' platform arg2 arg1 num_ops) + +orFoldingRules :: NumOps -> RuleM CoreExpr +orFoldingRules num_ops = do + env <- getRuleOpts + guard (roNumConstantFolding env) + [arg1,arg2] <- getArgs + platform <- getPlatform + liftMaybe + -- commutativity for `or` is handled here + (orFoldingRules' platform arg1 arg2 num_ops + <|> orFoldingRules' platform arg2 arg1 num_ops) addFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr addFoldingRules' platform arg1 arg2 num_ops = case (arg1, arg2) of @@ -2819,29 +2852,76 @@ mulFoldingRules' platform arg1 arg2 num_ops = case (arg1,arg2) of sub x y = BinOpApp x (numSub num_ops) y mul x y = BinOpApp x (numMul num_ops) y +andFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr +andFoldingRules' platform arg1 arg2 num_ops = case (arg1, arg2) of + -- R2) * `or` `and` simplications + -- l1 and (l2 and x) ==> (l1 and l2) and x + (L l1, is_lit_and num_ops -> Just (l2, x)) + -> Just (mkL (l1 .&. l2) `and` x) + + -- l1 and (l2 or x) ==> (l1 and l2) or (l1 and x) + -- does not decrease operations + + -- (l1 and x) and (l2 and y) ==> (l1 and l2) and (x and y) + (is_lit_and num_ops -> Just (l1, x), is_lit_and num_ops -> Just (l2, y)) + -> Just (mkL (l1 .&. l2) `and` (x `and` y)) + + -- (l1 and x) and (l2 or y) ==> (l1 and l2 and x) or (l1 and x and y) + -- (l1 or x) and (l2 or y) ==> (l1 and l2) or (x and l2) or (l1 and y) or (x and y) + -- increase operation numbers + + _ -> Nothing + where + mkL = Lit . mkNumLiteral platform num_ops + and x y = BinOpApp x (fromJust (numAnd num_ops)) y + +orFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr +orFoldingRules' platform arg1 arg2 num_ops = case (arg1, arg2) of + -- R2) * `or` `and` simplications + -- l1 or (l2 or x) ==> (l1 or l2) or x + (L l1, is_lit_or num_ops -> Just (l2, x)) + -> Just (mkL (l1 .|. l2) `or` x) + + -- l1 or (l2 and x) ==> (l1 or l2) and (l1 and x) + -- does not decrease operations + + -- (l1 or x) or (l2 or y) ==> (l1 or l2) or (x or y) + (is_lit_or num_ops -> Just (l1, x), is_lit_or num_ops -> Just (l2, y)) + -> Just (mkL (l1 .|. l2) `or` (x `or` y)) + + -- (l1 and x) or (l2 or y) ==> (l1 and l2 and x) or (l1 and x and y) + -- (l1 and x) or (l2 and y) ==> (l1 and l2) or (x and l2) or (l1 and y) or (x and y) + -- increase operation numbers + + _ -> Nothing + where + mkL = Lit . mkNumLiteral platform num_ops + or x y = BinOpApp x (fromJust (numOr num_ops)) y + is_op :: PrimOp -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr) is_op op e = case e of BinOpApp x op' y | op == op' -> Just (x,y) _ -> Nothing -is_add, is_sub, is_mul :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr) +is_add, is_sub, is_mul, is_and, is_or :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr) is_add num_ops = is_op (numAdd num_ops) is_sub num_ops = is_op (numSub num_ops) is_mul num_ops = is_op (numMul num_ops) - --- match addition with a literal (handles commutativity) -is_lit_add :: NumOps -> CoreExpr -> Maybe (Integer, Arg CoreBndr) -is_lit_add num_ops e = case is_add num_ops e of - Just (L l, x ) -> Just (l,x) - Just (x , L l) -> Just (l,x) - _ -> Nothing - --- match multiplication with a literal (handles commutativity) -is_lit_mul :: NumOps -> CoreExpr -> Maybe (Integer, Arg CoreBndr) -is_lit_mul num_ops e = case is_mul num_ops e of - Just (L l, x ) -> Just (l,x) - Just (x , L l) -> Just (l,x) - _ -> Nothing +is_and num_ops = is_op (fromJust (numAnd num_ops)) +is_or num_ops = is_op (fromJust (numOr num_ops)) + +-- match operation with a literal (handles commutativity) +is_lit_add, is_lit_mul, is_lit_and, is_lit_or :: NumOps -> CoreExpr -> Maybe (Integer, Arg CoreBndr) +is_lit_add num_ops e = is_lit' is_add num_ops e +is_lit_mul num_ops e = is_lit' is_mul num_ops e +is_lit_and num_ops e = is_lit' is_and num_ops e +is_lit_or num_ops e = is_lit' is_or num_ops e + +is_lit' :: (NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)) -> NumOps -> CoreExpr -> Maybe (Integer, Arg CoreBndr) +is_lit' f num_ops e = case f num_ops e of + Just (L l, x ) -> Just (l,x) + Just (x , L l) -> Just (l,x) + _ -> Nothing -- match given "x": return 1 -- match "lit * x": return lit value (handles commutativity) @@ -2875,6 +2955,8 @@ data NumOps = NumOps , numSub :: !PrimOp -- ^ Sub two numbers , numMul :: !PrimOp -- ^ Multiply two numbers , numLitType :: !LitNumType -- ^ Literal type + , numAnd :: !(Maybe PrimOp) -- ^ And two numbers + , numOr :: !(Maybe PrimOp) -- ^ Or two numbers } -- | Create a numeric literal @@ -2887,6 +2969,8 @@ int8Ops = NumOps , numSub = Int8SubOp , numMul = Int8MulOp , numLitType = LitNumInt8 + , numAnd = Nothing + , numOr = Nothing } word8Ops :: NumOps @@ -2894,6 +2978,8 @@ word8Ops = NumOps { numAdd = Word8AddOp , numSub = Word8SubOp , numMul = Word8MulOp + , numAnd = Just Word8AndOp + , numOr = Just Word8OrOp , numLitType = LitNumWord8 } @@ -2903,6 +2989,8 @@ int16Ops = NumOps , numSub = Int16SubOp , numMul = Int16MulOp , numLitType = LitNumInt16 + , numAnd = Nothing + , numOr = Nothing } word16Ops :: NumOps @@ -2910,6 +2998,8 @@ word16Ops = NumOps { numAdd = Word16AddOp , numSub = Word16SubOp , numMul = Word16MulOp + , numAnd = Just Word16AndOp + , numOr = Just Word16OrOp , numLitType = LitNumWord16 } @@ -2919,6 +3009,8 @@ int32Ops = NumOps , numSub = Int32SubOp , numMul = Int32MulOp , numLitType = LitNumInt32 + , numAnd = Nothing + , numOr = Nothing } word32Ops :: NumOps @@ -2926,6 +3018,8 @@ word32Ops = NumOps { numAdd = Word32AddOp , numSub = Word32SubOp , numMul = Word32MulOp + , numAnd = Just Word32AndOp + , numOr = Just Word32OrOp , numLitType = LitNumWord32 } @@ -2935,6 +3029,8 @@ int64Ops = NumOps , numSub = Int64SubOp , numMul = Int64MulOp , numLitType = LitNumInt64 + , numAnd = Nothing + , numOr = Nothing } word64Ops :: NumOps @@ -2942,6 +3038,8 @@ word64Ops = NumOps { numAdd = Word64AddOp , numSub = Word64SubOp , numMul = Word64MulOp + , numAnd = Just Word64AndOp + , numOr = Just Word64OrOp , numLitType = LitNumWord64 } @@ -2950,6 +3048,8 @@ intOps = NumOps { numAdd = IntAddOp , numSub = IntSubOp , numMul = IntMulOp + , numAnd = Just IntAndOp + , numOr = Just IntOrOp , numLitType = LitNumInt } @@ -2958,6 +3058,8 @@ wordOps = NumOps { numAdd = WordAddOp , numSub = WordSubOp , numMul = WordMulOp + , numAnd = Just WordAndOp + , numOr = Just WordOrOp , numLitType = LitNumWord } diff --git a/testsuite/tests/simplCore/should_run/T20203.hs b/testsuite/tests/simplCore/should_run/T20203.hs new file mode 100644 index 0000000000..ddfb06eb13 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T20203.hs @@ -0,0 +1,64 @@ +module T20203 where + +import Data.Bits +import Data.Int + +bitAndInt :: Int -> Int +bitAndInt x = (x .&. 0xFA) .&. 0xAF + +bitOrInt :: Int -> Int +bitOrInt x = (x .|. 0xFA) .|. 0xAF + +bitAndInt8 :: Int8 -> Int8 +bitAndInt8 x = (x .&. 0x1) .&. 0x10 + +bitOrInt8 :: Int8 -> Int8 +bitOrInt8 x = (x .|. 0x1) .|. 0x10 + +bitAndInt16 :: Int16 -> Int16 +bitAndInt16 x = (x .&. 0xFA) .&. 0xAF + +bitOrInt16 :: Int16 -> Int16 +bitOrInt16 x = (x .|. 0xFA) .|. 0xAF + +bitAndInt32 :: Int32 -> Int32 +bitAndInt32 x = (x .&. 0xFA) .&. 0xAF + +bitOrInt32 :: Int32 -> Int32 +bitOrInt32 x = (x .|. 0xFA) .|. 0xAF + +bitAndInt64 :: Int64 -> Int64 +bitAndInt64 x = (x .&. 0xFA) .&. 0xAF + +bitOrInt64 :: Int64 -> Int64 +bitOrInt64 x = (x .|. 0xFA) .|. 0xAF + +bitAndTwoVarInt :: Int -> Int -> Int +bitAndTwoVarInt x y = (x .&. 0xFA) .&. (y .&. 0xAF) + +bitOrTwoVarInt :: Int -> Int -> Int +bitOrTwoVarInt x y = (x .|. 0xFA) .|. (y .|. 0xAF) + +bitAndTwoVarInt8 :: Int8 -> Int8 -> Int8 +bitAndTwoVarInt8 x y = (x .&. 0x1) .&. (y .&. 0x10) + +bitOrTwoVarInt8 :: Int8 -> Int8 -> Int8 +bitOrTwoVarInt8 x y = (x .|. 0x1) .|. (y .|. 0x10) + +bitAndTwoVarInt16 :: Int16 -> Int16 -> Int16 +bitAndTwoVarInt16 x y = (x .&. 0xFA) .&. (y .&. 0xAF) + +bitOrTwoVarInt16 :: Int16 -> Int16 -> Int16 +bitOrTwoVarInt16 x y = (x .|. 0xFA) .|. (y .|. 0xAF) + +bitAndTwoVarInt32 :: Int32 -> Int32 -> Int32 +bitAndTwoVarInt32 x y = (x .&. 0xFA) .&. (y .&. 0xAF) + +bitOrTwoVarInt32 :: Int32 -> Int32 -> Int32 +bitOrTwoVarInt32 x y = (x .|. 0xFA) .|. (y .|. 0xAF) + +bitAndTwoVarInt64 :: Int64 -> Int64 -> Int64 +bitAndTwoVarInt64 x y = (x .&. 0xFA) .&. (y .&. 0xAF) + +bitOrTwoVarInt64 :: Int64 -> Int64 -> Int64 +bitOrTwoVarInt64 x y = (x .|. 0xFA) .|. (y .|. 0xAF) diff --git a/testsuite/tests/simplCore/should_run/T20203.stderr-ws-32 b/testsuite/tests/simplCore/should_run/T20203.stderr-ws-32 new file mode 100644 index 0000000000..2d904fc5a4 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T20203.stderr-ws-32 @@ -0,0 +1,153 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 290, types: 141, coercions: 0, joins: 0/0} + +bitOrTwoVarInt + = \ x y -> + case x of { I# x# -> + case y of { I# x#1 -> I# (orI# 255# (orI# x# x#1)) } + } + +bitAndTwoVarInt + = \ x y -> + case x of { I# x# -> + case y of { I# x#1 -> I# (andI# 170# (andI# x# x#1)) } + } + +bitOrInt = \ x -> case x of { I# x# -> I# (orI# 255# x#) } + +bitAndInt = \ x -> case x of { I# x# -> I# (andI# 170# x#) } + +bitOrTwoVarInt8 + = \ x y -> + case x of { I8# x# -> + case y of { I8# x#1 -> + I8# + (word8ToInt8# + (orWord8# 17##8 (orWord8# (int8ToWord8# x#) (int8ToWord8# x#1)))) + } + } + +bitAndInt1 = I8# 0#8 + +bitAndTwoVarInt8 + = \ x y -> + case x of { I8# x# -> case y of { I8# x#1 -> bitAndInt1 } } + +bitOrInt8 + = \ x -> + case x of { I8# x# -> + I8# (word8ToInt8# (orWord8# 17##8 (int8ToWord8# x#))) + } + +bitAndInt8 = \ x -> case x of { I8# x# -> bitAndInt1 } + +bitOrTwoVarInt16 + = \ x y -> + case x of { I16# x# -> + case y of { I16# x#1 -> + I16# + (word16ToInt16# + (orWord16# + 255##16 (orWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + } + } + +bitAndTwoVarInt16 + = \ x y -> + case x of { I16# x# -> + case y of { I16# x#1 -> + I16# + (word16ToInt16# + (andWord16# + 170##16 (andWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + } + } + +bitOrInt16 + = \ x -> + case x of { I16# x# -> + I16# (word16ToInt16# (orWord16# 255##16 (int16ToWord16# x#))) + } + +bitAndInt16 + = \ x -> + case x of { I16# x# -> + I16# (word16ToInt16# (andWord16# 170##16 (int16ToWord16# x#))) + } + +bitOrTwoVarInt32 + = \ x y -> + case x of { I32# x# -> + case y of { I32# x#1 -> + I32# + (intToInt32# + (orI# + (int32ToInt# (intToInt32# (orI# (int32ToInt# x#) 250#))) + (int32ToInt# (intToInt32# (orI# (int32ToInt# x#1) 175#))))) + } + } + +bitAndTwoVarInt32 + = \ x y -> + case x of { I32# x# -> + case y of { I32# x#1 -> + I32# + (intToInt32# + (andI# + (int32ToInt# (intToInt32# (andI# (int32ToInt# x#) 250#))) + (int32ToInt# (intToInt32# (andI# (int32ToInt# x#1) 175#))))) + } + } + +bitOrInt32 + = \ x -> + case x of { I32# x# -> + I32# + (intToInt32# + (orI# + (int32ToInt# (intToInt32# (orI# (int32ToInt# x#) 250#))) 175#)) + } + +bitAndInt32 + = \ x -> + case x of { I32# x# -> + I32# + (intToInt32# + (andI# + (int32ToInt# (intToInt32# (andI# (int32ToInt# x#) 250#))) 175#)) + } + +bitOrTwoVarInt64 + = \ x y -> + case x of { I64# x# -> + case y of { I64# x#1 -> + I64# + (word64ToInt64# + (or64# 255##64 (or64# (int64ToWord64# x#) (int64ToWord64# x#1)))) + } + } + +bitAndTwoVarInt64 + = \ x y -> + case x of { I64# x# -> + case y of { I64# x#1 -> + I64# + (word64ToInt64# + (and64# 170##64 (and64# (int64ToWord64# x#) (int64ToWord64# x#1)))) + } + } + +bitOrInt64 + = / x -> + case x of { I64# x# -> + I64# (word64ToInt64# (or64# 255##64 (int64ToWord64# x#))) + } + +bitAndInt64 + = / x -> + case x of { I64# x# -> + I64# (word64ToInt64# (and64# 170##64 (int64ToWord64# x#))) + } + diff --git a/testsuite/tests/simplCore/should_run/T20203.stderr-ws-64 b/testsuite/tests/simplCore/should_run/T20203.stderr-ws-64 new file mode 100644 index 0000000000..1ef5a70af8 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T20203.stderr-ws-64 @@ -0,0 +1,138 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 280, types: 141, coercions: 0, joins: 0/0} + +bitOrTwoVarInt + = \ x y -> + case x of { I# x# -> + case y of { I# x#1 -> I# (orI# 255# (orI# x# x#1)) } + } + +bitAndTwoVarInt + = \ x y -> + case x of { I# x# -> + case y of { I# x#1 -> I# (andI# 170# (andI# x# x#1)) } + } + +bitOrInt = \ x -> case x of { I# x# -> I# (orI# 255# x#) } + +bitAndInt = \ x -> case x of { I# x# -> I# (andI# 170# x#) } + +bitOrTwoVarInt8 + = \ x y -> + case x of { I8# x# -> + case y of { I8# x#1 -> + I8# + (word8ToInt8# + (orWord8# 17##8 (orWord8# (int8ToWord8# x#) (int8ToWord8# x#1)))) + } + } + +bitAndInt1 = I8# 0#8 + +bitAndTwoVarInt8 + = \ x y -> + case x of { I8# x# -> case y of { I8# x#1 -> bitAndInt1 } } + +bitOrInt8 + = \ x -> + case x of { I8# x# -> + I8# (word8ToInt8# (orWord8# 17##8 (int8ToWord8# x#))) + } + +bitAndInt8 = \ x -> case x of { I8# x# -> bitAndInt1 } + +bitOrTwoVarInt16 + = \ x y -> + case x of { I16# x# -> + case y of { I16# x#1 -> + I16# + (word16ToInt16# + (orWord16# + 255##16 (orWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + } + } + +bitAndTwoVarInt16 + = \ x y -> + case x of { I16# x# -> + case y of { I16# x#1 -> + I16# + (word16ToInt16# + (andWord16# + 170##16 (andWord16# (int16ToWord16# x#) (int16ToWord16# x#1)))) + } + } + +bitOrInt16 + = \ x -> + case x of { I16# x# -> + I16# (word16ToInt16# (orWord16# 255##16 (int16ToWord16# x#))) + } + +bitAndInt16 + = \ x -> + case x of { I16# x# -> + I16# (word16ToInt16# (andWord16# 170##16 (int16ToWord16# x#))) + } + +bitOrTwoVarInt32 + = \ x y -> + case x of { I32# x# -> + case y of { I32# x#1 -> + I32# + (intToInt32# + (orI# + (int32ToInt# (intToInt32# (orI# (int32ToInt# x#) 250#))) + (int32ToInt# (intToInt32# (orI# (int32ToInt# x#1) 175#))))) + } + } + +bitAndTwoVarInt32 + = \ x y -> + case x of { I32# x# -> + case y of { I32# x#1 -> + I32# + (intToInt32# + (andI# + (int32ToInt# (intToInt32# (andI# (int32ToInt# x#) 250#))) + (int32ToInt# (intToInt32# (andI# (int32ToInt# x#1) 175#))))) + } + } + +bitOrInt32 + = \ x -> + case x of { I32# x# -> + I32# + (intToInt32# + (orI# + (int32ToInt# (intToInt32# (orI# (int32ToInt# x#) 250#))) 175#)) + } + +bitAndInt32 + = \ x -> + case x of { I32# x# -> + I32# + (intToInt32# + (andI# + (int32ToInt# (intToInt32# (andI# (int32ToInt# x#) 250#))) 175#)) + } + +bitOrTwoVarInt64 + = \ x y -> + case x of { I64# x# -> + case y of { I64# x#1 -> I64# (orI# 255# (orI# x# x#1)) } + } + +bitAndTwoVarInt64 + = \ x y -> + case x of { I64# x# -> + case y of { I64# x#1 -> I64# (andI# 170# (andI# x# x#1)) } + } + +bitOrInt64 = \ x -> case x of { I64# x# -> I64# (orI# 255# x#) } + +bitAndInt64 = \ x -> case x of { I64# x# -> I64# (andI# 170# x#) } + + diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index a6458ee311..fe6b5d3479 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -98,3 +98,4 @@ test('NumConstantFolding16', normal, compile_and_run, ['']) test('NumConstantFolding32', normal, compile_and_run, ['']) test('NumConstantFolding', normal, compile_and_run, ['']) test('T19413', normal, compile_and_run, ['']) +test('T20203', normal, compile, ['-O -dsuppress-all -dsuppress-uniques -dno-typeable-binds -ddump-simpl'])
\ No newline at end of file |