{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

Conceptually, constant folding should be parameterized with the kind
of target machine to get identical behaviour during compilation time
and runtime. We cheat a little bit here...

ToDo:
   check boundaries before folding, e.g. we can fold the Float addition
   (i1 + i2) only if it results in a valid Float.
-}

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE -Wno-incomplete-uni-patterns #-}

-- | Constant Folder
module GHC.Core.Opt.ConstantFold
   ( primOpRules
   , builtinRules
   , caseRules
   )
where

import GHC.Prelude

import GHC.Platform

import GHC.Types.Id.Make ( unboxedUnitExpr )
import GHC.Types.Id
import GHC.Types.Literal
import GHC.Types.Name.Occurrence ( occNameFS )
import GHC.Types.Tickish
import GHC.Types.Name ( Name, nameOccName )
import GHC.Types.Basic

import GHC.Core
import GHC.Core.Make
import GHC.Core.SimpleOpt (  exprIsConApp_maybe, exprIsLiteral_maybe )
import GHC.Core.DataCon ( DataCon,dataConTagZ, dataConTyCon, dataConWrapId, dataConWorkId )
import GHC.Core.Utils  ( cheapEqExpr, exprIsHNF
                       , stripTicksTop, stripTicksTopT, mkTicks )
import GHC.Core.Multiplicity
import GHC.Core.Rules.Config
import GHC.Core.Type
import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.TyCon
   ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon
   , isNewTyCon, tyConDataCons
   , tyConFamilySize )
import GHC.Core.Map.Expr ( eqCoreExpr )

import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey )
import GHC.Builtin.PrimOps.Ids (primOpId)
import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Builtin.Names

import GHC.Data.FastString
import GHC.Data.Maybe      ( orElse )

import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain

import Control.Applicative ( Alternative(..) )
import Control.Monad
import Data.Functor (($>))
import qualified Data.ByteString as BS
import Data.Ratio
import Data.Word
import Data.Maybe (fromMaybe, fromJust)

{-
Note [Constant folding]
~~~~~~~~~~~~~~~~~~~~~~~
primOpRules generates a rewrite rule for each primop
These rules do what is often called "constant folding"
E.g. the rules for +# might say
        4 +# 5 = 9
Well, of course you'd need a lot of rules if you did it
like that, so we use a BuiltinRule instead, so that we
can match in any two literal values.  So the rule is really
more like
        (Lit x) +# (Lit y) = Lit (x+#y)
where the (+#) on the rhs is done at compile time

That is why these rules are built in here.
-}

primOpRules ::  Name -> PrimOp -> Maybe CoreRule
primOpRules :: Name -> PrimOp -> Maybe CoreRule
primOpRules Name
nm = \case
   PrimOp
TagToEnumOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ RuleM CoreExpr
tagToEnumRule ]
   PrimOp
DataToTagOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ RuleM CoreExpr
dataToTagRule ]

   -- Int8 operations
   PrimOp
Int8AddOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroI8
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Int8AddOp NumOps
int8Ops
                                    ]
   PrimOp
Int8SubOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 (-))
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI8
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI8
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Int8SubOp NumOps
int8Ops
                                    ]
   PrimOp
Int8MulOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , RuleM CoreExpr
zeroElem
                                    , Literal -> RuleM CoreExpr
identity Literal
oneI8
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Int8MulOp NumOps
int8Ops
                                    ]
   PrimOp
Int8QuotOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , RuleM CoreExpr
leftZero
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
oneI8
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
oneI8 ]
   PrimOp
Int8RemOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI8
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI8 ]
   PrimOp
Int8NegOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Int8NegOp ]
   PrimOp
Int8SllOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt8 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI8 ]
   PrimOp
Int8SraOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt8 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI8 ]
   PrimOp
Int8SrlOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt8 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
 -> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word8
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI8 ]

   -- Word8 operations
   PrimOp
Word8AddOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW8
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Word8AddOp NumOps
word8Ops
                                    ]
   PrimOp
Word8SubOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 (-))
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroW8
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW8
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Word8SubOp NumOps
word8Ops
                                    ]
   PrimOp
Word8MulOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , Literal -> RuleM CoreExpr
identity Literal
oneW8
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Word8MulOp NumOps
word8Ops
                                    ]
   PrimOp
Word8QuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
oneW8 ]
   PrimOp
Word8RemOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW8
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW8 ]
   PrimOp
Word8AndOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
                                    , RuleM CoreExpr
idempotent
                                    , RuleM CoreExpr
zeroElem
                                    , Literal -> RuleM CoreExpr
identity (Integer -> Literal
mkLitWord8 Integer
0xFF)
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word8AndOp
                                    , NumOps -> RuleM CoreExpr
andFoldingRules NumOps
word8Ops
                                    ]
   PrimOp
Word8OrOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
                                    , RuleM CoreExpr
idempotent
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW8
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word8OrOp
                                    , NumOps -> RuleM CoreExpr
orFoldingRules NumOps
word8Ops
                                    ]
   PrimOp
Word8XorOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW8
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW8 ]
   PrimOp
Word8NotOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Word8NotOp ]
   PrimOp
Word8SllOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord8 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
   PrimOp
Word8SrlOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord8 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
 -> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word8 ]


   -- Int16 operations
   PrimOp
Int16AddOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroI16
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Int16AddOp NumOps
int16Ops
                                    ]
   PrimOp
Int16SubOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 (-))
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI16
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI16
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Int16SubOp NumOps
int16Ops
                                    ]
   PrimOp
Int16MulOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , RuleM CoreExpr
zeroElem
                                    , Literal -> RuleM CoreExpr
identity Literal
oneI16
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Int16MulOp NumOps
int16Ops
                                    ]
   PrimOp
Int16QuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , RuleM CoreExpr
leftZero
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
oneI16
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
oneI16 ]
   PrimOp
Int16RemOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI16
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI16 ]
   PrimOp
Int16NegOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Int16NegOp ]
   PrimOp
Int16SllOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt16 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI16 ]
   PrimOp
Int16SraOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt16 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI16 ]
   PrimOp
Int16SrlOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt16 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
 -> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word16
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI16 ]

   -- Word16 operations
   PrimOp
Word16AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW16
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Word16AddOp NumOps
word16Ops
                                    ]
   PrimOp
Word16SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 (-))
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroW16
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW16
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Word16SubOp NumOps
word16Ops
                                    ]
   PrimOp
Word16MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , Literal -> RuleM CoreExpr
identity Literal
oneW16
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Word16MulOp NumOps
word16Ops
                                    ]
   PrimOp
Word16QuotOp-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
oneW16 ]
   PrimOp
Word16RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW16
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW16 ]
   PrimOp
Word16AndOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
                                    , RuleM CoreExpr
idempotent
                                    , RuleM CoreExpr
zeroElem
                                    , Literal -> RuleM CoreExpr
identity (Integer -> Literal
mkLitWord16 Integer
0xFFFF)
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word16AndOp
                                    , NumOps -> RuleM CoreExpr
andFoldingRules NumOps
word16Ops
                                    ]
   PrimOp
Word16OrOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
                                    , RuleM CoreExpr
idempotent
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW16
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word16OrOp
                                    , NumOps -> RuleM CoreExpr
orFoldingRules NumOps
word16Ops
                                    ]
   PrimOp
Word16XorOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW16
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW16 ]
   PrimOp
Word16NotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Word16NotOp ]
   PrimOp
Word16SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord16 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
   PrimOp
Word16SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord16 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
 -> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word16 ]


   -- Int32 operations
   PrimOp
Int32AddOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroI32
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Int32AddOp NumOps
int32Ops
                                    ]
   PrimOp
Int32SubOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 (-))
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI32
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI32
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Int32SubOp NumOps
int32Ops
                                    ]
   PrimOp
Int32MulOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , RuleM CoreExpr
zeroElem
                                    , Literal -> RuleM CoreExpr
identity Literal
oneI32
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Int32MulOp NumOps
int32Ops
                                    ]
   PrimOp
Int32QuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , RuleM CoreExpr
leftZero
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
oneI32
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
oneI32 ]
   PrimOp
Int32RemOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI32
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI32 ]
   PrimOp
Int32NegOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Int32NegOp ]
   PrimOp
Int32SllOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt32 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI32 ]
   PrimOp
Int32SraOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt32 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI32 ]
   PrimOp
Int32SrlOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt32 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
 -> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word32
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI32 ]

   -- Word32 operations
   PrimOp
Word32AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW32
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Word32AddOp NumOps
word32Ops
                                    ]
   PrimOp
Word32SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 (-))
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroW32
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW32
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Word32SubOp NumOps
word32Ops
                                    ]
   PrimOp
Word32MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , Literal -> RuleM CoreExpr
identity Literal
oneW32
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Word32MulOp NumOps
word32Ops
                                    ]
   PrimOp
Word32QuotOp-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
oneW32 ]
   PrimOp
Word32RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW32
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW32 ]
   PrimOp
Word32AndOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
                                    , RuleM CoreExpr
idempotent
                                    , RuleM CoreExpr
zeroElem
                                    , Literal -> RuleM CoreExpr
identity (Integer -> Literal
mkLitWord32 Integer
0xFFFFFFFF)
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word32AndOp
                                    , NumOps -> RuleM CoreExpr
andFoldingRules NumOps
word32Ops
                                    ]
   PrimOp
Word32OrOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
                                    , RuleM CoreExpr
idempotent
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW32
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word32OrOp
                                    , NumOps -> RuleM CoreExpr
orFoldingRules NumOps
word32Ops
                                    ]
   PrimOp
Word32XorOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW32
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW32 ]
   PrimOp
Word32NotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Word32NotOp ]
   PrimOp
Word32SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord32 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
   PrimOp
Word32SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord32 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
 -> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word32 ]

   -- Int64 operations
   PrimOp
Int64AddOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroI64
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Int64AddOp NumOps
int64Ops
                                    ]
   PrimOp
Int64SubOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 (-))
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI64
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI64
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Int64SubOp NumOps
int64Ops
                                    ]
   PrimOp
Int64MulOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , RuleM CoreExpr
zeroElem
                                    , Literal -> RuleM CoreExpr
identity Literal
oneI64
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Int64MulOp NumOps
int64Ops
                                    ]
   PrimOp
Int64QuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , RuleM CoreExpr
leftZero
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
oneI64
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
oneI64 ]
   PrimOp
Int64RemOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI64
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI64 ]
   PrimOp
Int64NegOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Int64NegOp ]
   PrimOp
Int64SllOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt64 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI64 ]
   PrimOp
Int64SraOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt64 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI64 ]
   PrimOp
Int64SrlOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt64 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
 -> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word64
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI64 ]

   -- Word64 operations
   PrimOp
Word64AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW64
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Word64AddOp NumOps
word64Ops
                                    ]
   PrimOp
Word64SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 (-))
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
zeroW64
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW64
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Word64SubOp NumOps
word64Ops
                                    ]
   PrimOp
Word64MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , Literal -> RuleM CoreExpr
identity Literal
oneW64
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Word64MulOp NumOps
word64Ops
                                    ]
   PrimOp
Word64QuotOp-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , Literal -> RuleM CoreExpr
rightIdentity Literal
oneW64 ]
   PrimOp
Word64RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW64
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW64 ]
   PrimOp
Word64AndOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
                                    , RuleM CoreExpr
idempotent
                                    , RuleM CoreExpr
zeroElem
                                    , Literal -> RuleM CoreExpr
identity (Integer -> Literal
mkLitWord64 Integer
0xFFFFFFFFFFFFFFFF)
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word64AndOp
                                    , NumOps -> RuleM CoreExpr
andFoldingRules NumOps
word64Ops
                                    ]
   PrimOp
Word64OrOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
                                    , RuleM CoreExpr
idempotent
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW64
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word64OrOp
                                    , NumOps -> RuleM CoreExpr
orFoldingRules NumOps
word64Ops
                                    ]
   PrimOp
Word64XorOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
                                    , Literal -> RuleM CoreExpr
identity Literal
zeroW64
                                    , RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW64 ]
   PrimOp
Word64NotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Word64NotOp ]
   PrimOp
Word64SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord64 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
   PrimOp
Word64SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord64 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
 -> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word64 ]

   -- Int operations
   PrimOp
IntAddOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zeroi
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
IntAddOp NumOps
intOps
                                    ]
   PrimOp
IntSubOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 (-))
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
IntSubOp NumOps
intOps
                                    ]
   PrimOp
IntAddCOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityCPlatform Platform -> Literal
zeroi ]
   PrimOp
IntSubCOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 (-))
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityCPlatform Platform -> Literal
zeroi
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLitNoC Platform -> Literal
zeroi ]
   PrimOp
IntMulOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , RuleM CoreExpr
zeroElem
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
onei
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
IntMulOp NumOps
intOps
                                    ]
   PrimOp
IntMul2Op   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ do
                                        [Lit (LitNumber LitNumType
_ Integer
l1), Lit (LitNumber LitNumType
_ Integer
l2)] <- RuleM [CoreExpr]
getArgs
                                        Platform
platform <- RuleM Platform
getPlatform
                                        let r :: Integer
r = Integer
l1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
l2
                                        CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple
                                          [ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (if Platform -> Integer -> Bool
platformInIntRange Platform
platform Integer
r then Platform -> Literal
zeroi Platform
platform else Platform -> Literal
onei Platform
platform)
                                          , Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkIntLitWrap Platform
platform (Integer
r Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
`shiftR` Platform -> ConTagZ
platformWordSizeInBits Platform
platform)
                                          , Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkIntLitWrap Platform
platform Integer
r
                                          ]

                                    , RuleM CoreExpr
zeroElem RuleM CoreExpr -> (CoreExpr -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CoreExpr
z ->
                                        CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [CoreExpr
z,CoreExpr
z,CoreExpr
z])

                                      -- timesInt2# 1# other
                                      -- ~~~>
                                      -- (# 0#, 0# -# (other >># (WORD_SIZE_IN_BITS-1)), other #)
                                      -- The second element is the sign bit
                                      -- repeated to fill a word.
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
onei RuleM CoreExpr -> (CoreExpr -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CoreExpr
other -> do
                                        Platform
platform <- RuleM Platform
getPlatform
                                        CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple
                                          [ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)
                                          , CoreExpr -> [CoreExpr] -> CoreExpr
mkCoreApps (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
IntSubOp))
                                              [ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)
                                              , CoreExpr -> [CoreExpr] -> CoreExpr
mkCoreApps (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
IntSrlOp))
                                                [ CoreExpr
other
                                                , Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkIntLit Platform
platform (ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Platform -> ConTagZ
platformWordSizeInBits Platform
platform ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
- ConTagZ
1))
                                                ]
                                              ]
                                          , CoreExpr
other
                                          ]
                                    ]
   PrimOp
IntQuotOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , RuleM CoreExpr
leftZero
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
onei
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
onei ]
   PrimOp
IntRemOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi ]
   PrimOp
IntAndOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
                                    , RuleM CoreExpr
idempotent
                                    , RuleM CoreExpr
zeroElem
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform (\Platform
p -> Platform -> Integer -> Literal
mkLitInt Platform
p (-Integer
1))
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
IntAndOp
                                    , NumOps -> RuleM CoreExpr
andFoldingRules NumOps
intOps
                                    ]
   PrimOp
IntOrOp     -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
                                    , RuleM CoreExpr
idempotent
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zeroi
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
IntOrOp
                                    , NumOps -> RuleM CoreExpr
orFoldingRules NumOps
intOps
                                    ]
   PrimOp
IntXorOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zeroi
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi ]
   PrimOp
IntNotOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
IntNotOp ]
   PrimOp
IntNegOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
IntNegOp ]
   PrimOp
IntSllOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi ]
   PrimOp
IntSraOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi ]
   PrimOp
IntSrlOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt Platform -> Integer -> ConTagZ -> Integer
shiftRightLogicalNative
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi ]

   -- Word operations
   PrimOp
WordAddOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zerow
                                    , PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
WordAddOp NumOps
wordOps
                                    ]
   PrimOp
WordSubOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 (-))
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zerow
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow
                                    , PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
WordSubOp NumOps
wordOps
                                    ]
   PrimOp
WordAddCOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityCPlatform Platform -> Literal
zerow ]
   PrimOp
WordSubCOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 (-))
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityCPlatform Platform -> Literal
zerow
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLitNoC Platform -> Literal
zerow ]
   PrimOp
WordMulOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
onew
                                    , PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
WordMulOp NumOps
wordOps
                                    ]
   PrimOp
WordQuotOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
onew ]
   PrimOp
WordRemOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
                                    , RuleM CoreExpr
leftZero
                                    , ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow ]
   PrimOp
WordAndOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
                                    , RuleM CoreExpr
idempotent
                                    , RuleM CoreExpr
zeroElem
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform (\Platform
p -> Platform -> Integer -> Literal
mkLitWord Platform
p (Platform -> Integer
platformMaxWord Platform
p))
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
WordAndOp
                                    , NumOps -> RuleM CoreExpr
andFoldingRules NumOps
wordOps
                                    ]
   PrimOp
WordOrOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
                                    , RuleM CoreExpr
idempotent
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zerow
                                    , PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
WordOrOp
                                    , NumOps -> RuleM CoreExpr
orFoldingRules NumOps
wordOps
                                    ]
   PrimOp
WordXorOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zerow
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow ]
   PrimOp
WordNotOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
                                    , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
WordNotOp ]
   PrimOp
WordSllOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
   PrimOp
WordSrlOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord Platform -> Integer -> ConTagZ -> Integer
shiftRightLogicalNative ]

   PrimOp
PopCnt8Op   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word8  ]
   PrimOp
PopCnt16Op  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word16 ]
   PrimOp
PopCnt32Op  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word32 ]
   PrimOp
PopCnt64Op  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word64 ]
   PrimOp
PopCntOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ RuleM PlatformWordSize
getWordSize RuleM PlatformWordSize
-> (PlatformWordSize -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                        PlatformWordSize
PW4 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word32
                                        PlatformWordSize
PW8 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word64
                                    ]

   PrimOp
Ctz8Op      -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word8  ]
   PrimOp
Ctz16Op     -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word16 ]
   PrimOp
Ctz32Op     -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word32 ]
   PrimOp
Ctz64Op     -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word64 ]
   PrimOp
CtzOp       -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ RuleM PlatformWordSize
getWordSize RuleM PlatformWordSize
-> (PlatformWordSize -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                        PlatformWordSize
PW4 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word32
                                        PlatformWordSize
PW8 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word64
                                    ]

   PrimOp
Clz8Op      -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word8  ]
   PrimOp
Clz16Op     -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word16 ]
   PrimOp
Clz32Op     -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word32 ]
   PrimOp
Clz64Op     -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word64 ]
   PrimOp
ClzOp       -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ RuleM PlatformWordSize
getWordSize RuleM PlatformWordSize
-> (PlatformWordSize -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                        PlatformWordSize
PW4 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word32
                                        PlatformWordSize
PW8 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word64
                                    ]

   -- coercions

   PrimOp
Int8ToIntOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToIntLit ]
   PrimOp
Int16ToIntOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToIntLit ]
   PrimOp
Int32ToIntOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToIntLit ]
   PrimOp
Int64ToIntOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToIntLit ]
   PrimOp
IntToInt8Op    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowInt8Lit
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
IntToInt8Op ConTagZ
8 ]
   PrimOp
IntToInt16Op   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowInt16Lit
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
IntToInt16Op ConTagZ
16 ]
   PrimOp
IntToInt32Op   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowInt32Lit
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
IntToInt32Op ConTagZ
32 ]
   PrimOp
IntToInt64Op   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowInt64Lit ]

   PrimOp
Word8ToWordOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToWordLit
                                       , PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough PrimOp
WordToWord8Op Integer
0xFF
                                       ]
   PrimOp
Word16ToWordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToWordLit
                                       , PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough PrimOp
WordToWord16Op Integer
0xFFFF
                                       ]
   PrimOp
Word32ToWordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToWordLit
                                       , PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough PrimOp
WordToWord32Op Integer
0xFFFFFFFF
                                       ]
   PrimOp
Word64ToWordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToWordLit ]

   PrimOp
WordToWord8Op  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowWord8Lit
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
WordToWord8Op ConTagZ
8 ]
   PrimOp
WordToWord16Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowWord16Lit
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
WordToWord16Op ConTagZ
16 ]
   PrimOp
WordToWord32Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowWord32Lit
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
WordToWord32Op ConTagZ
32 ]
   PrimOp
WordToWord64Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowWord64Lit ]

   PrimOp
Word8ToInt8Op  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt8) ]
   PrimOp
Int8ToWord8Op  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord8) ]
   PrimOp
Word16ToInt16Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt16) ]
   PrimOp
Int16ToWord16Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord16) ]
   PrimOp
Word32ToInt32Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt32) ]
   PrimOp
Int32ToWord32Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord32) ]
   PrimOp
Word64ToInt64Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt64) ]
   PrimOp
Int64ToWord64Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord64) ]

   PrimOp
WordToIntOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt) ]
   PrimOp
IntToWordOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord) ]

   PrimOp
Narrow8IntOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumInt8)
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8IntOp
                                       , PrimOp
Narrow8IntOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow16IntOp
                                       , PrimOp
Narrow8IntOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow32IntOp
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
Narrow8IntOp ConTagZ
8 ]
   PrimOp
Narrow16IntOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumInt16)
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8IntOp
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow16IntOp
                                       , PrimOp
Narrow16IntOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow32IntOp
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
Narrow16IntOp ConTagZ
16 ]
   PrimOp
Narrow32IntOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumInt32)
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8IntOp
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow16IntOp
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow32IntOp
                                       , RuleM CoreExpr
removeOp32
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
Narrow32IntOp ConTagZ
32 ]
   PrimOp
Narrow8WordOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumWord8)
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8WordOp
                                       , PrimOp
Narrow8WordOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow16WordOp
                                       , PrimOp
Narrow8WordOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow32WordOp
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
Narrow8WordOp ConTagZ
8 ]
   PrimOp
Narrow16WordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumWord16)
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8WordOp
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow16WordOp
                                       , PrimOp
Narrow16WordOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow32WordOp
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
Narrow16WordOp ConTagZ
16 ]
   PrimOp
Narrow32WordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumWord32)
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8WordOp
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow16WordOp
                                       , PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow32WordOp
                                       , RuleM CoreExpr
removeOp32
                                       , PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
Narrow32WordOp ConTagZ
32 ]

   PrimOp
OrdOp          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
charToIntLit
                                       , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
ChrOp ]
   PrimOp
ChrOp          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ do [Lit Literal
lit] <- RuleM [CoreExpr]
getArgs
                                            Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Literal -> Bool
litFitsInChar Literal
lit)
                                            (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
intToCharLit
                                       , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
OrdOp ]
   PrimOp
FloatToIntOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
floatToIntLit ]
   PrimOp
IntToFloatOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
intToFloatLit ]
   PrimOp
DoubleToIntOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
doubleToIntLit ]
   PrimOp
IntToDoubleOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
intToDoubleLit ]
   -- SUP: Not sure what the standard says about precision in the following 2 cases
   PrimOp
FloatToDoubleOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
floatToDoubleLit ]
   PrimOp
DoubleToFloatOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
doubleToFloatLit ]

   -- Float
   PrimOp
FloatAddOp        -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+))
                                          , Literal -> RuleM CoreExpr
identity Literal
zerof ]
   PrimOp
FloatSubOp        -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 (-))
                                          , Literal -> RuleM CoreExpr
rightIdentity Literal
zerof ]
   PrimOp
FloatMulOp        -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*))
                                          , Literal -> RuleM CoreExpr
identity Literal
onef
                                          , Literal -> PrimOp -> RuleM CoreExpr
strengthReduction Literal
twof PrimOp
FloatAddOp  ]
             -- zeroElem zerof doesn't hold because of NaN
   PrimOp
FloatDivOp        -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ RuleM ()
guardFloatDiv RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(/))
                                          , Literal -> RuleM CoreExpr
rightIdentity Literal
onef ]
   PrimOp
FloatNegOp        -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
                                          , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
FloatNegOp ]
   PrimOp
FloatDecode_IntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
floatDecodeOp ]

   -- Double
   PrimOp
DoubleAddOp          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+))
                                             , Literal -> RuleM CoreExpr
identity Literal
zerod ]
   PrimOp
DoubleSubOp          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 (-))
                                             , Literal -> RuleM CoreExpr
rightIdentity Literal
zerod ]
   PrimOp
DoubleMulOp          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*))
                                             , Literal -> RuleM CoreExpr
identity Literal
oned
                                             , Literal -> PrimOp -> RuleM CoreExpr
strengthReduction Literal
twod PrimOp
DoubleAddOp  ]
              -- zeroElem zerod doesn't hold because of NaN
   PrimOp
DoubleDivOp          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ RuleM ()
guardDoubleDiv RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(/))
                                             , Literal -> RuleM CoreExpr
rightIdentity Literal
oned ]
   PrimOp
DoubleNegOp          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
                                             , PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
DoubleNegOp ]
   PrimOp
DoubleDecode_Int64Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
doubleDecodeOp ]

   -- Relational operators, equality

   PrimOp
Int8EqOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
Int8NeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
Int16EqOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
Int16NeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
Int32EqOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
Int32NeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
Int64EqOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
Int64NeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
IntEqOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
IntNeOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
Word8EqOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
Word8NeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
Word16EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
Word16NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
Word32EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
Word32NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
Word64EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
Word64NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
WordEqOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
WordNeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
CharEqOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
CharNeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
FloatEqOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==)
   PrimOp
FloatNeOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=)

   PrimOp
DoubleEqOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==)
   PrimOp
DoubleNeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=)

   -- Relational operators, ordering

   PrimOp
Int8GtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
Int8GeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
Int8LeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
Int8LtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
Int16GtOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
Int16GeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
Int16LeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
Int16LtOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
Int32GtOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
Int32GeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
Int32LeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
Int32LtOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
Int64GtOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
Int64GeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
Int64LeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
Int64LtOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
IntGtOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
IntGeOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
IntLeOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
IntLtOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
Word8GtOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
Word8GeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
Word8LeOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
Word8LtOp  -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
Word16GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
Word16GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
Word16LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
Word16LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
Word32GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
Word32GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
Word32LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
Word32LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
Word64GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
Word64GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
Word64LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
Word64LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
WordGtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
WordGeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
WordLeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
WordLtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
CharGtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
CharGeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
CharLeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
CharLtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
FloatGtOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
   PrimOp
FloatGeOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
   PrimOp
FloatLeOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
   PrimOp
FloatLtOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)

   PrimOp
DoubleGtOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
   PrimOp
DoubleGeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
   PrimOp
DoubleLeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
   PrimOp
DoubleLtOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)

   -- Misc

   PrimOp
AddrAddOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi ]

   PrimOp
SeqOp      -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
4 [ RuleM CoreExpr
seqRule ]
   PrimOp
SparkOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
4 [ RuleM CoreExpr
sparkRule ]

   PrimOp
_          -> Maybe CoreRule
forall a. Maybe a
Nothing

{-
************************************************************************
*                                                                      *
\subsection{Doing the business}
*                                                                      *
************************************************************************
-}

-- useful shorthands
mkPrimOpRule :: Name -> Int -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule :: Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
arity [RuleM CoreExpr]
rules = CoreRule -> Maybe CoreRule
forall a. a -> Maybe a
Just (CoreRule -> Maybe CoreRule) -> CoreRule -> Maybe CoreRule
forall a b. (a -> b) -> a -> b
$ Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkBasicRule Name
nm ConTagZ
arity ([RuleM CoreExpr] -> RuleM CoreExpr
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [RuleM CoreExpr]
rules)

mkRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)
            -> [RuleM CoreExpr] -> Maybe CoreRule
mkRelOpRule :: Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
cmp [RuleM CoreExpr]
extra
  = Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 ([RuleM CoreExpr] -> Maybe CoreRule)
-> [RuleM CoreExpr] -> Maybe CoreRule
forall a b. (a -> b) -> a -> b
$
    (forall a. Ord a => a -> a -> Bool) -> RuleM CoreExpr
binaryCmpLit a -> a -> Bool
forall a. Ord a => a -> a -> Bool
cmp RuleM CoreExpr -> [RuleM CoreExpr] -> [RuleM CoreExpr]
forall a. a -> [a] -> [a]
: RuleM CoreExpr
equal_rule RuleM CoreExpr -> [RuleM CoreExpr] -> [RuleM CoreExpr]
forall a. a -> [a] -> [a]
: [RuleM CoreExpr]
extra
  where
        -- x `cmp` x does not depend on x, so
        -- compute it for the arbitrary value 'True'
        -- and use that result
    equal_rule :: RuleM CoreExpr
equal_rule = do { RuleM ()
equalArgs
                    ; Platform
platform <- RuleM Platform
getPlatform
                    ; CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
cmp Bool
True Bool
True
                              then Platform -> CoreExpr
trueValInt  Platform
platform
                              else Platform -> CoreExpr
falseValInt Platform
platform) }

{- Note [Rules for floating-point comparisons]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We need different rules for floating-point values because for floats
it is not true that x = x (for NaNs); so we do not want the equal_rule
rule that mkRelOpRule uses.

Note also that, in the case of equality/inequality, we do /not/
want to switch to a case-expression.  For example, we do not want
to convert
   case (eqFloat# x 3.8#) of
     True -> this
     False -> that
to
  case x of
    3.8#::Float# -> this
    _            -> that
See #9238.  Reason: comparing floating-point values for equality
delicate, and we don't want to implement that delicacy in the code for
case expressions.  So we make it an invariant of Core that a case
expression never scrutinises a Float# or Double#.

This transformation is what the litEq rule does;
see Note [The litEq rule: converting equality to case].
So we /refrain/ from using litEq for mkFloatingRelOpRule.
-}

mkFloatingRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)
                    -> Maybe CoreRule
-- See Note [Rules for floating-point comparisons]
mkFloatingRelOpRule :: Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
cmp
  = Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [(forall a. Ord a => a -> a -> Bool) -> RuleM CoreExpr
binaryCmpLit a -> a -> Bool
forall a. Ord a => a -> a -> Bool
cmp]

-- common constants
zeroi, onei, zerow, onew :: Platform -> Literal
zeroi :: Platform -> Literal
zeroi Platform
platform = Platform -> Integer -> Literal
mkLitInt  Platform
platform Integer
0
onei :: Platform -> Literal
onei  Platform
platform = Platform -> Integer -> Literal
mkLitInt  Platform
platform Integer
1
zerow :: Platform -> Literal
zerow Platform
platform = Platform -> Integer -> Literal
mkLitWord Platform
platform Integer
0
onew :: Platform -> Literal
onew  Platform
platform = Platform -> Integer -> Literal
mkLitWord Platform
platform Integer
1

zeroI8, oneI8, zeroW8, oneW8 :: Literal
zeroI8 :: Literal
zeroI8 = Integer -> Literal
mkLitInt8  Integer
0
oneI8 :: Literal
oneI8  = Integer -> Literal
mkLitInt8  Integer
1
zeroW8 :: Literal
zeroW8 = Integer -> Literal
mkLitWord8 Integer
0
oneW8 :: Literal
oneW8  = Integer -> Literal
mkLitWord8 Integer
1

zeroI16, oneI16, zeroW16, oneW16 :: Literal
zeroI16 :: Literal
zeroI16 = Integer -> Literal
mkLitInt16  Integer
0
oneI16 :: Literal
oneI16  = Integer -> Literal
mkLitInt16  Integer
1
zeroW16 :: Literal
zeroW16 = Integer -> Literal
mkLitWord16 Integer
0
oneW16 :: Literal
oneW16  = Integer -> Literal
mkLitWord16 Integer
1

zeroI32, oneI32, zeroW32, oneW32 :: Literal
zeroI32 :: Literal
zeroI32 = Integer -> Literal
mkLitInt32  Integer
0
oneI32 :: Literal
oneI32  = Integer -> Literal
mkLitInt32  Integer
1
zeroW32 :: Literal
zeroW32 = Integer -> Literal
mkLitWord32 Integer
0
oneW32 :: Literal
oneW32  = Integer -> Literal
mkLitWord32 Integer
1

zeroI64, oneI64, zeroW64, oneW64 :: Literal
zeroI64 :: Literal
zeroI64 = Integer -> Literal
mkLitInt64  Integer
0
oneI64 :: Literal
oneI64  = Integer -> Literal
mkLitInt64  Integer
1
zeroW64 :: Literal
zeroW64 = Integer -> Literal
mkLitWord64 Integer
0
oneW64 :: Literal
oneW64  = Integer -> Literal
mkLitWord64 Integer
1

zerof, onef, twof, zerod, oned, twod :: Literal
zerof :: Literal
zerof = Rational -> Literal
mkLitFloat Rational
0.0
onef :: Literal
onef  = Rational -> Literal
mkLitFloat Rational
1.0
twof :: Literal
twof  = Rational -> Literal
mkLitFloat Rational
2.0
zerod :: Literal
zerod = Rational -> Literal
mkLitDouble Rational
0.0
oned :: Literal
oned  = Rational -> Literal
mkLitDouble Rational
1.0
twod :: Literal
twod  = Rational -> Literal
mkLitDouble Rational
2.0

cmpOp :: Platform -> (forall a . Ord a => a -> a -> Bool)
      -> Literal -> Literal -> Maybe CoreExpr
cmpOp :: Platform
-> (forall a. Ord a => a -> a -> Bool)
-> Literal
-> Literal
-> Maybe CoreExpr
cmpOp Platform
platform forall a. Ord a => a -> a -> Bool
cmp = Literal -> Literal -> Maybe CoreExpr
go
  where
    done :: Bool -> Maybe CoreExpr
done Bool
True  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
trueValInt  Platform
platform
    done Bool
False = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
falseValInt Platform
platform

    -- These compares are at different types
    go :: Literal -> Literal -> Maybe CoreExpr
go (LitChar Char
i1)   (LitChar Char
i2)   = Bool -> Maybe CoreExpr
done (Char
i1 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
`cmp` Char
i2)
    go (LitFloat Rational
i1)  (LitFloat Rational
i2)  = Bool -> Maybe CoreExpr
done (Rational
i1 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
`cmp` Rational
i2)
    go (LitDouble Rational
i1) (LitDouble Rational
i2) = Bool -> Maybe CoreExpr
done (Rational
i1 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
`cmp` Rational
i2)
    go (LitNumber LitNumType
nt1 Integer
i1) (LitNumber LitNumType
nt2 Integer
i2)
      | LitNumType
nt1 LitNumType -> LitNumType -> Bool
forall a. Eq a => a -> a -> Bool
/= LitNumType
nt2 = Maybe CoreExpr
forall a. Maybe a
Nothing
      | Bool
otherwise  = Bool -> Maybe CoreExpr
done (Integer
i1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
`cmp` Integer
i2)
    go Literal
_               Literal
_               = Maybe CoreExpr
forall a. Maybe a
Nothing

--------------------------

negOp :: RuleOpts -> Literal -> Maybe CoreExpr  -- Negate
negOp :: RuleOpts -> Literal -> Maybe CoreExpr
negOp RuleOpts
env = \case
   (LitFloat Rational
0.0)  -> Maybe CoreExpr
forall a. Maybe a
Nothing  -- can't represent -0.0 as a Rational
   (LitFloat Rational
f)    -> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (RuleOpts -> Rational -> CoreExpr
mkFloatVal RuleOpts
env (-Rational
f))
   (LitDouble Rational
0.0) -> Maybe CoreExpr
forall a. Maybe a
Nothing
   (LitDouble Rational
d)   -> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (RuleOpts -> Rational -> CoreExpr
mkDoubleVal RuleOpts
env (-Rational
d))
   (LitNumber LitNumType
nt Integer
i)
      | LitNumType -> Bool
litNumIsSigned LitNumType
nt -> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap (RuleOpts -> Platform
roPlatform RuleOpts
env) LitNumType
nt (-Integer
i)))
   Literal
_ -> Maybe CoreExpr
forall a. Maybe a
Nothing

complementOp :: RuleOpts -> Literal -> Maybe CoreExpr  -- Binary complement
complementOp :: RuleOpts -> Literal -> Maybe CoreExpr
complementOp RuleOpts
env (LitNumber LitNumType
nt Integer
i) =
   CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap (RuleOpts -> Platform
roPlatform RuleOpts
env) LitNumType
nt (Integer -> Integer
forall a. Bits a => a -> a
complement Integer
i)))
complementOp RuleOpts
_      Literal
_            = Maybe CoreExpr
forall a. Maybe a
Nothing

int8Op2
  :: (Integral a, Integral b)
  => (a -> b -> Integer)
  -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumInt8 Integer
i1) (LitNumber LitNumType
LitNumInt8 Integer
i2) =
  Integer -> Maybe CoreExpr
int8Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
int8Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

int16Op2
  :: (Integral a, Integral b)
  => (a -> b -> Integer)
  -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumInt16 Integer
i1) (LitNumber LitNumType
LitNumInt16 Integer
i2) =
  Integer -> Maybe CoreExpr
int16Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
int16Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

int32Op2
  :: (Integral a, Integral b)
  => (a -> b -> Integer)
  -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumInt32 Integer
i1) (LitNumber LitNumType
LitNumInt32 Integer
i2) =
  Integer -> Maybe CoreExpr
int32Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
int32Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

int64Op2
  :: (Integral a, Integral b)
  => (a -> b -> Integer)
  -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumInt64 Integer
i1) (LitNumber LitNumType
LitNumInt64 Integer
i2) =
  Integer -> Maybe CoreExpr
int64Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
int64Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

intOp2 :: (Integral a, Integral b)
       => (a -> b -> Integer)
       -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 = (RuleOpts -> a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(RuleOpts -> a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2' ((RuleOpts -> a -> b -> Integer)
 -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> ((a -> b -> Integer) -> RuleOpts -> a -> b -> Integer)
-> (a -> b -> Integer)
-> RuleOpts
-> Literal
-> Literal
-> Maybe CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> Integer) -> RuleOpts -> a -> b -> Integer
forall a b. a -> b -> a
const

intOp2' :: (Integral a, Integral b)
        => (RuleOpts -> a -> b -> Integer)
        -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2' :: forall a b.
(Integral a, Integral b) =>
(RuleOpts -> a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2' RuleOpts -> a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumInt Integer
i1) (LitNumber LitNumType
LitNumInt Integer
i2) =
  let o :: a -> b -> Integer
o = RuleOpts -> a -> b -> Integer
op RuleOpts
env
  in  Platform -> Integer -> Maybe CoreExpr
intResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`o` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
intOp2' RuleOpts -> a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

intOpC2 :: (Integral a, Integral b)
        => (a -> b -> Integer)
        -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumInt Integer
i1) (LitNumber LitNumType
LitNumInt Integer
i2) =
  Platform -> Integer -> Maybe CoreExpr
intCResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
intOpC2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

shiftRightLogical :: forall t. (Integral t, Bits t) => Integer -> Int -> Integer
shiftRightLogical :: forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical Integer
x ConTagZ
n = t -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> t
forall a. Num a => Integer -> a
fromInteger Integer
x t -> ConTagZ -> t
forall a. Bits a => a -> ConTagZ -> a
`shiftR` ConTagZ
n :: t)

-- | Shift right, putting zeros in rather than sign-propagating as
-- 'Bits.shiftR' would do. Do this by converting to the appropriate Word
-- and back. Obviously this won't work for too-big values, but its ok as
-- we use it here.
shiftRightLogicalNative :: Platform -> Integer -> Int -> Integer
shiftRightLogicalNative :: Platform -> Integer -> ConTagZ -> Integer
shiftRightLogicalNative Platform
platform =
    case Platform -> PlatformWordSize
platformWordSize Platform
platform of
      PlatformWordSize
PW4 -> forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word32
      PlatformWordSize
PW8 -> forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word64

--------------------------
retLit :: (Platform -> Literal) -> RuleM CoreExpr
retLit :: (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
l = do Platform
platform <- RuleM Platform
getPlatform
              CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> Literal
l Platform
platform

retLitNoC :: (Platform -> Literal) -> RuleM CoreExpr
retLitNoC :: (Platform -> Literal) -> RuleM CoreExpr
retLitNoC Platform -> Literal
l = do Platform
platform <- RuleM Platform
getPlatform
                 let lit :: Literal
lit = Platform -> Literal
l Platform
platform
                 CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit, Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)]

word8Op2
  :: (Integral a, Integral b)
  => (a -> b -> Integer)
  -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumWord8 Integer
i1) (LitNumber LitNumType
LitNumWord8 Integer
i2) =
  Integer -> Maybe CoreExpr
word8Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
word8Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

word16Op2
  :: (Integral a, Integral b)
  => (a -> b -> Integer)
  -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumWord16 Integer
i1) (LitNumber LitNumType
LitNumWord16 Integer
i2) =
  Integer -> Maybe CoreExpr
word16Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
word16Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

word32Op2
  :: (Integral a, Integral b)
  => (a -> b -> Integer)
  -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumWord32 Integer
i1) (LitNumber LitNumType
LitNumWord32 Integer
i2) =
  Integer -> Maybe CoreExpr
word32Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
word32Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

word64Op2
  :: (Integral a, Integral b)
  => (a -> b -> Integer)
  -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumWord64 Integer
i1) (LitNumber LitNumType
LitNumWord64 Integer
i2) =
  Integer -> Maybe CoreExpr
word64Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
word64Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

wordOp2 :: (Integral a, Integral b)
        => (a -> b -> Integer)
        -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumWord Integer
w1) (LitNumber LitNumType
LitNumWord Integer
w2)
    = Platform -> Integer -> Maybe CoreExpr
wordResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
w1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
w2)
wordOp2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

wordOpC2 :: (Integral a, Integral b)
        => (a -> b -> Integer)
        -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumWord Integer
w1) (LitNumber LitNumType
LitNumWord Integer
w2) =
  Platform -> Integer -> Maybe CoreExpr
wordCResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
w1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
w2)
wordOpC2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

shiftRule :: LitNumType
          -> (Platform -> Integer -> Int -> Integer)
          -> RuleM CoreExpr
-- Shifts take an Int; hence third arg of op is Int
-- Used for shift primops
--    IntSllOp, IntSraOp, IntSrlOp :: Int# -> Int# -> Int#
--    SllOp, SrlOp                 :: Word# -> Int# -> Word#
shiftRule :: LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
lit_num_ty Platform -> Integer -> ConTagZ -> Integer
shift_op = do
  Platform
platform <- RuleM Platform
getPlatform
  [CoreExpr
e1, Lit (LitNumber LitNumType
LitNumInt Integer
shift_len)] <- RuleM [CoreExpr]
getArgs

  Integer
bit_size <- case Platform -> LitNumType -> Maybe Word
litNumBitSize Platform
platform LitNumType
lit_num_ty of
   Maybe Word
Nothing -> RuleM Integer
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
   Just Word
bs -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
bs)

  case CoreExpr
e1 of
    CoreExpr
_ | Integer
shift_len Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoreExpr
e1

      -- See Note [Guarding against silly shifts]
    CoreExpr
_ | Integer
shift_len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
shift_len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
bit_size
      -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
lit_num_ty Integer
0
           -- Be sure to use lit_num_ty here, so we get a correctly typed zero.
           -- See #18589

    Lit (LitNumber LitNumType
nt Integer
x)
       | Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
shift_len Bool -> Bool -> Bool
&& Integer
shift_len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
bit_size
       -> Bool -> RuleM CoreExpr -> RuleM CoreExpr
forall a. HasCallStack => Bool -> a -> a
assert (LitNumType
nt LitNumType -> LitNumType -> Bool
forall a. Eq a => a -> a -> Bool
== LitNumType
lit_num_ty) (RuleM CoreExpr -> RuleM CoreExpr)
-> RuleM CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$
          let op :: Integer -> ConTagZ -> Integer
op = Platform -> Integer -> ConTagZ -> Integer
shift_op Platform
platform
              -- Do the shift at type Integer, but shift length is Int.
              -- Using host's Int is ok even if target's Int has a different size
              -- because we test that shift_len <= bit_size (which is at most 64)
              y :: Integer
y  = Integer
x Integer -> ConTagZ -> Integer
`op` Integer -> ConTagZ
forall a. Num a => Integer -> a
fromInteger Integer
shift_len
          in CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
nt Integer
y

    CoreExpr
_ -> RuleM CoreExpr
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

--------------------------
floatOp2 :: (Rational -> Rational -> Rational)
         -> RuleOpts -> Literal -> Literal
         -> Maybe (Expr CoreBndr)
floatOp2 :: (Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 Rational -> Rational -> Rational
op RuleOpts
env (LitFloat Rational
f1) (LitFloat Rational
f2)
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (RuleOpts -> Rational -> CoreExpr
mkFloatVal RuleOpts
env (Rational
f1 Rational -> Rational -> Rational
`op` Rational
f2))
floatOp2 Rational -> Rational -> Rational
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

--------------------------
floatDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr
floatDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr
floatDecodeOp RuleOpts
env (LitFloat ((Float -> (Integer, ConTagZ)
forall a. RealFloat a => a -> (Integer, ConTagZ)
decodeFloat (Float -> (Integer, ConTagZ))
-> (Rational -> Float) -> Rational -> (Integer, ConTagZ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational @Float) -> (Integer
m, ConTagZ
e)))
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [ Platform -> Integer -> CoreExpr
mkIntVal (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
m)
                              , Platform -> Integer -> CoreExpr
mkIntVal (RuleOpts -> Platform
roPlatform RuleOpts
env) (ConTagZ -> Integer
forall a. Integral a => a -> Integer
toInteger ConTagZ
e) ]
floatDecodeOp RuleOpts
_   Literal
_
  = Maybe CoreExpr
forall a. Maybe a
Nothing

--------------------------
doubleOp2 :: (Rational -> Rational -> Rational)
          -> RuleOpts -> Literal -> Literal
          -> Maybe (Expr CoreBndr)
doubleOp2 :: (Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 Rational -> Rational -> Rational
op RuleOpts
env (LitDouble Rational
f1) (LitDouble Rational
f2)
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (RuleOpts -> Rational -> CoreExpr
mkDoubleVal RuleOpts
env (Rational
f1 Rational -> Rational -> Rational
`op` Rational
f2))
doubleOp2 Rational -> Rational -> Rational
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

--------------------------
doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr
doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr
doubleDecodeOp RuleOpts
env (LitDouble ((Double -> (Integer, ConTagZ)
forall a. RealFloat a => a -> (Integer, ConTagZ)
decodeFloat (Double -> (Integer, ConTagZ))
-> (Rational -> Double) -> Rational -> (Integer, ConTagZ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational @Double) -> (Integer
m, ConTagZ
e)))
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt64Wrap (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
m))
                              , Platform -> Integer -> CoreExpr
mkIntVal Platform
platform (ConTagZ -> Integer
forall a. Integral a => a -> Integer
toInteger ConTagZ
e) ]
  where
    platform :: Platform
platform = RuleOpts -> Platform
roPlatform RuleOpts
env
doubleDecodeOp RuleOpts
_   Literal
_
  = Maybe CoreExpr
forall a. Maybe a
Nothing

--------------------------
{- Note [The litEq rule: converting equality to case]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This stuff turns
     n ==# 3#
into
     case n of
       3# -> True
       m  -> False

This is a Good Thing, because it allows case-of case things
to happen, and case-default absorption to happen.  For
example:

     if (n ==# 3#) || (n ==# 4#) then e1 else e2
will transform to
     case n of
       3# -> e1
       4# -> e1
       m  -> e2
(modulo the usual precautions to avoid duplicating e1)
-}

litEq :: Bool  -- True <=> equality, False <=> inequality
      -> RuleM CoreExpr
litEq :: Bool -> RuleM CoreExpr
litEq Bool
is_eq = [RuleM CoreExpr] -> RuleM CoreExpr
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
  [ do [Lit Literal
lit, CoreExpr
expr] <- RuleM [CoreExpr]
getArgs
       Platform
platform <- RuleM Platform
getPlatform
       Platform -> Literal -> CoreExpr -> RuleM CoreExpr
do_lit_eq Platform
platform Literal
lit CoreExpr
expr
  , do [CoreExpr
expr, Lit Literal
lit] <- RuleM [CoreExpr]
getArgs
       Platform
platform <- RuleM Platform
getPlatform
       Platform -> Literal -> CoreExpr -> RuleM CoreExpr
do_lit_eq Platform
platform Literal
lit CoreExpr
expr ]
  where
    do_lit_eq :: Platform -> Literal -> CoreExpr -> RuleM CoreExpr
do_lit_eq Platform
platform Literal
lit CoreExpr
expr = do
      Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Literal -> Bool
litIsLifted Literal
lit))
      CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Scaled Type -> Type -> [CoreAlt] -> CoreExpr
mkWildCase CoreExpr
expr (Type -> Scaled Type
forall a. a -> Scaled a
unrestricted (Type -> Scaled Type) -> Type -> Scaled Type
forall a b. (a -> b) -> a -> b
$ Literal -> Type
literalType Literal
lit) Type
intPrimTy
                    [ AltCon -> [Id] -> CoreExpr -> CoreAlt
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
DEFAULT      [] CoreExpr
val_if_neq
                    , AltCon -> [Id] -> CoreExpr -> CoreAlt
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt (Literal -> AltCon
LitAlt Literal
lit) [] CoreExpr
val_if_eq])
      where
        val_if_eq :: CoreExpr
val_if_eq  | Bool
is_eq     = Platform -> CoreExpr
trueValInt  Platform
platform
                   | Bool
otherwise = Platform -> CoreExpr
falseValInt Platform
platform
        val_if_neq :: CoreExpr
val_if_neq | Bool
is_eq     = Platform -> CoreExpr
falseValInt Platform
platform
                   | Bool
otherwise = Platform -> CoreExpr
trueValInt  Platform
platform


-- | Check if there is comparison with minBound or maxBound, that is
-- always true or false. For instance, an Int cannot be smaller than its
-- minBound, so we can replace such comparison with False.
boundsCmp :: Comparison -> RuleM CoreExpr
boundsCmp :: Comparison -> RuleM CoreExpr
boundsCmp Comparison
op = do
  Platform
platform <- RuleM Platform
getPlatform
  [CoreExpr
a, CoreExpr
b] <- RuleM [CoreExpr]
getArgs
  Maybe CoreExpr -> RuleM CoreExpr
forall a. Maybe a -> RuleM a
liftMaybe (Maybe CoreExpr -> RuleM CoreExpr)
-> Maybe CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> Comparison -> CoreExpr -> CoreExpr -> Maybe CoreExpr
mkRuleFn Platform
platform Comparison
op CoreExpr
a CoreExpr
b

data Comparison = Gt | Ge | Lt | Le

mkRuleFn :: Platform -> Comparison -> CoreExpr -> CoreExpr -> Maybe CoreExpr
mkRuleFn :: Platform -> Comparison -> CoreExpr -> CoreExpr -> Maybe CoreExpr
mkRuleFn Platform
platform Comparison
Gt (Lit Literal
lit) CoreExpr
_ | Platform -> Literal -> Bool
isMinBound Platform
platform Literal
lit = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
falseValInt Platform
platform
mkRuleFn Platform
platform Comparison
Le (Lit Literal
lit) CoreExpr
_ | Platform -> Literal -> Bool
isMinBound Platform
platform Literal
lit = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
trueValInt  Platform
platform
mkRuleFn Platform
platform Comparison
Ge CoreExpr
_ (Lit Literal
lit) | Platform -> Literal -> Bool
isMinBound Platform
platform Literal
lit = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
trueValInt  Platform
platform
mkRuleFn Platform
platform Comparison
Lt CoreExpr
_ (Lit Literal
lit) | Platform -> Literal -> Bool
isMinBound Platform
platform Literal
lit = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
falseValInt Platform
platform
mkRuleFn Platform
platform Comparison
Ge (Lit Literal
lit) CoreExpr
_ | Platform -> Literal -> Bool
isMaxBound Platform
platform Literal
lit = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
trueValInt  Platform
platform
mkRuleFn Platform
platform Comparison
Lt (Lit Literal
lit) CoreExpr
_ | Platform -> Literal -> Bool
isMaxBound Platform
platform Literal
lit = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
falseValInt Platform
platform
mkRuleFn Platform
platform Comparison
Gt CoreExpr
_ (Lit Literal
lit) | Platform -> Literal -> Bool
isMaxBound Platform
platform Literal
lit = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
falseValInt Platform
platform
mkRuleFn Platform
platform Comparison
Le CoreExpr
_ (Lit Literal
lit) | Platform -> Literal -> Bool
isMaxBound Platform
platform Literal
lit = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
trueValInt  Platform
platform
mkRuleFn Platform
_ Comparison
_ CoreExpr
_ CoreExpr
_                                           = Maybe CoreExpr
forall a. Maybe a
Nothing

-- | Create an Int literal expression while ensuring the given Integer is in the
-- target Int range
int8Result :: Integer -> Maybe CoreExpr
int8Result :: Integer -> Maybe CoreExpr
int8Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
int8Result' Integer
result)

int8Result' :: Integer -> CoreExpr
int8Result' :: Integer -> CoreExpr
int8Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt8Wrap Integer
result)

-- | Create an Int literal expression while ensuring the given Integer is in the
-- target Int range
int16Result :: Integer -> Maybe CoreExpr
int16Result :: Integer -> Maybe CoreExpr
int16Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
int16Result' Integer
result)

int16Result' :: Integer -> CoreExpr
int16Result' :: Integer -> CoreExpr
int16Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt16Wrap Integer
result)

-- | Create an Int literal expression while ensuring the given Integer is in the
-- target Int range
int32Result :: Integer -> Maybe CoreExpr
int32Result :: Integer -> Maybe CoreExpr
int32Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
int32Result' Integer
result)

int32Result' :: Integer -> CoreExpr
int32Result' :: Integer -> CoreExpr
int32Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt32Wrap Integer
result)

intResult :: Platform -> Integer -> Maybe CoreExpr
intResult :: Platform -> Integer -> Maybe CoreExpr
intResult Platform
platform Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Platform -> Integer -> CoreExpr
intResult' Platform
platform Integer
result)

intResult' :: Platform -> Integer -> CoreExpr
intResult' :: Platform -> Integer -> CoreExpr
intResult' Platform
platform Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitIntWrap Platform
platform Integer
result)

-- | Create an unboxed pair of an Int literal expression, ensuring the given
-- Integer is in the target Int range and the corresponding overflow flag
-- (@0#@/@1#@) if it wasn't.
intCResult :: Platform -> Integer -> Maybe CoreExpr
intCResult :: Platform -> Integer -> Maybe CoreExpr
intCResult Platform
platform Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just ([CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit, Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
c])
  where
    (Literal
lit, Bool
b) = Platform -> Integer -> (Literal, Bool)
mkLitIntWrapC Platform
platform Integer
result
    c :: Literal
c = if Bool
b then Platform -> Literal
onei Platform
platform else Platform -> Literal
zeroi Platform
platform

-- | Create a Word literal expression while ensuring the given Integer is in the
-- target Word range
word8Result :: Integer -> Maybe CoreExpr
word8Result :: Integer -> Maybe CoreExpr
word8Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
word8Result' Integer
result)

word8Result' :: Integer -> CoreExpr
word8Result' :: Integer -> CoreExpr
word8Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord8Wrap Integer
result)

-- | Create a Word literal expression while ensuring the given Integer is in the
-- target Word range
word16Result :: Integer -> Maybe CoreExpr
word16Result :: Integer -> Maybe CoreExpr
word16Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
word16Result' Integer
result)

word16Result' :: Integer -> CoreExpr
word16Result' :: Integer -> CoreExpr
word16Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord16Wrap Integer
result)

-- | Create a Word literal expression while ensuring the given Integer is in the
-- target Word range
word32Result :: Integer -> Maybe CoreExpr
word32Result :: Integer -> Maybe CoreExpr
word32Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
word32Result' Integer
result)

word32Result' :: Integer -> CoreExpr
word32Result' :: Integer -> CoreExpr
word32Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord32Wrap Integer
result)

-- | Create a Word literal expression while ensuring the given Integer is in the
-- target Word range
wordResult :: Platform -> Integer -> Maybe CoreExpr
wordResult :: Platform -> Integer -> Maybe CoreExpr
wordResult Platform
platform Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Platform -> Integer -> CoreExpr
wordResult' Platform
platform Integer
result)

wordResult' :: Platform -> Integer -> CoreExpr
wordResult' :: Platform -> Integer -> CoreExpr
wordResult' Platform
platform Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitWordWrap Platform
platform Integer
result)

-- | Create an unboxed pair of a Word literal expression, ensuring the given
-- Integer is in the target Word range and the corresponding carry flag
-- (@0#@/@1#@) if it wasn't.
wordCResult :: Platform -> Integer -> Maybe CoreExpr
wordCResult :: Platform -> Integer -> Maybe CoreExpr
wordCResult Platform
platform Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just ([CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit, Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
c])
  where
    (Literal
lit, Bool
b) = Platform -> Integer -> (Literal, Bool)
mkLitWordWrapC Platform
platform Integer
result
    c :: Literal
c = if Bool
b then Platform -> Literal
onei Platform
platform else Platform -> Literal
zeroi Platform
platform

int64Result :: Integer -> Maybe CoreExpr
int64Result :: Integer -> Maybe CoreExpr
int64Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
int64Result' Integer
result)

int64Result' :: Integer -> CoreExpr
int64Result' :: Integer -> CoreExpr
int64Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt64Wrap Integer
result)

word64Result :: Integer -> Maybe CoreExpr
word64Result :: Integer -> Maybe CoreExpr
word64Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
word64Result' Integer
result)

word64Result' :: Integer -> CoreExpr
word64Result' :: Integer -> CoreExpr
word64Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord64Wrap Integer
result)


-- | 'ambient (primop x) = x', but not necessarily 'primop (ambient x) = x'.
semiInversePrimOp :: PrimOp -> RuleM CoreExpr
semiInversePrimOp :: PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
primop = do
  [Var Id
primop_id `App` CoreExpr
e] <- RuleM [CoreExpr]
getArgs
  PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
primop Id
primop_id
  CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e

subsumesPrimOp :: PrimOp -> PrimOp -> RuleM CoreExpr
PrimOp
this subsumesPrimOp :: PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
that = do
  [Var Id
primop_id `App` CoreExpr
e] <- RuleM [CoreExpr]
getArgs
  PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
that Id
primop_id
  CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
this) CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
e)

subsumedByPrimOp :: PrimOp -> RuleM CoreExpr
subsumedByPrimOp :: PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
primop = do
  [e :: CoreExpr
e@(Var Id
primop_id `App` CoreExpr
_)] <- RuleM [CoreExpr]
getArgs
  PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
primop Id
primop_id
  CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e

-- | Transform `extendWordN (narrowWordN x)` into `x .&. 0xFF..FF`
extendNarrowPassthrough :: PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough :: PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough PrimOp
narrow_primop Integer
n = do
  [Var Id
primop_id `App` CoreExpr
x] <- RuleM [CoreExpr]
getArgs
  PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
narrow_primop Id
primop_id
  CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
WordAndOp) CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumWord Integer
n))

-- | narrow subsumes bitwise `and` with full mask (cf #16402):
--
--       narrowN (x .&. m)
--       m .&. (2^N-1) = 2^N-1
--       ==> narrowN x
--
-- e.g.  narrow16 (x .&. 0xFFFF)
--       ==> narrow16 x
--
narrowSubsumesAnd :: PrimOp -> PrimOp -> Int -> RuleM CoreExpr
narrowSubsumesAnd :: PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
and_primop PrimOp
narrw ConTagZ
n = do
  [Var Id
primop_id `App` CoreExpr
x `App` CoreExpr
y] <- RuleM [CoreExpr]
getArgs
  PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
and_primop Id
primop_id
  let mask :: Integer
mask = ConTagZ -> Integer
forall a. Bits a => ConTagZ -> a
bit ConTagZ
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1
      g :: CoreExpr -> CoreExpr -> RuleM CoreExpr
g CoreExpr
v (Lit (LitNumber LitNumType
_ Integer
m)) = do
         Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
m Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
mask)
         CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
narrw) CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
v)
      g CoreExpr
_ CoreExpr
_ = RuleM CoreExpr
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  CoreExpr -> CoreExpr -> RuleM CoreExpr
g CoreExpr
x CoreExpr
y RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
forall a. RuleM a -> RuleM a -> RuleM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CoreExpr -> CoreExpr -> RuleM CoreExpr
g CoreExpr
y CoreExpr
x

idempotent :: RuleM CoreExpr
idempotent :: RuleM CoreExpr
idempotent = do [CoreExpr
e1, CoreExpr
e2] <- RuleM [CoreExpr]
getArgs
                Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e1 CoreExpr
e2
                CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1

-- | Match
--       (op (op v e) e)
--    or (op e (op v e))
--    or (op (op e v) e)
--    or (op e (op e v))
--  and return the innermost (op v e) or (op e v).
sameArgIdempotentCommut :: PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut :: PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
op = do
  [CoreExpr
a,CoreExpr
b] <- RuleM [CoreExpr]
getArgs
  case (CoreExpr
a,CoreExpr
b) of
    (PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop PrimOp
op -> Just (CoreExpr
e1,CoreExpr
e2), CoreExpr
e3)
      | CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e2 CoreExpr
e3 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
a
      | CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e1 CoreExpr
e3 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
a
    (CoreExpr
e3, PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop PrimOp
op -> Just (CoreExpr
e1,CoreExpr
e2))
      | CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e2 CoreExpr
e3 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
b
      | CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e1 CoreExpr
e3 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
b
    (CoreExpr, CoreExpr)
_ -> RuleM CoreExpr
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

{-
Note [Guarding against silly shifts]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this code:

  import Data.Bits( (.|.), shiftL )
  chunkToBitmap :: [Bool] -> Word32
  chunkToBitmap chunk = foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip chunk [0..] ]

This optimises to:
Shift.$wgo = \ (w_sCS :: GHC.Prim.Int#) (w1_sCT :: [GHC.Types.Bool]) ->
    case w1_sCT of _ {
      [] -> 0##;
      : x_aAW xs_aAX ->
        case x_aAW of _ {
          GHC.Types.False ->
            case w_sCS of wild2_Xh {
              __DEFAULT -> Shift.$wgo (GHC.Prim.+# wild2_Xh 1) xs_aAX;
              9223372036854775807 -> 0## };
          GHC.Types.True ->
            case GHC.Prim.>=# w_sCS 64 of _ {
              GHC.Types.False ->
                case w_sCS of wild3_Xh {
                  __DEFAULT ->
                    case Shift.$wgo (GHC.Prim.+# wild3_Xh 1) xs_aAX of ww_sCW { __DEFAULT ->
                      GHC.Prim.or# (GHC.Prim.narrow32Word#
                                      (GHC.Prim.uncheckedShiftL# 1## wild3_Xh))
                                   ww_sCW
                     };
                  9223372036854775807 ->
                    GHC.Prim.narrow32Word#
!!!!-->                  (GHC.Prim.uncheckedShiftL# 1## 9223372036854775807)
                };
              GHC.Types.True ->
                case w_sCS of wild3_Xh {
                  __DEFAULT -> Shift.$wgo (GHC.Prim.+# wild3_Xh 1) xs_aAX;
                  9223372036854775807 -> 0##
                } } } }

Note the massive shift on line "!!!!".  It can't happen, because we've checked
that w < 64, but the optimiser didn't spot that. We DO NOT want to constant-fold this!
Moreover, if the programmer writes (n `uncheckedShiftL` 9223372036854775807), we
can't constant fold it, but if it gets to the assembler 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 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-can-float
invariant (see Note [Core let-can-float invariant] in GHC.Core) as noted in #16742.
For the reasons discussed in Note [Checking versus non-checking
primops] (in the PrimOp module) there is no safe way to 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:

- Shifting fixed-width things: the primops IntSll, Sll, etc
  These are handled by shiftRule.

  We are happy to shift by any amount up to wordSize but no more.

- Shifting Bignums (Integer, Natural): these are handled by bignum_shift.

  Here we could in principle shift by any amount, but we arbitrary
  limit the shift to 4 bits; in particular we do not want shift by a
  huge amount, which can happen in code like that above.

The two cases are more different in their code paths that is comfortable,
but that is only a historical accident.


************************************************************************
*                                                                      *
\subsection{Vaguely generic functions}
*                                                                      *
************************************************************************
-}

mkBasicRule :: Name -> Int -> RuleM CoreExpr -> CoreRule
-- Gives the Rule the same name as the primop itself
mkBasicRule :: Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkBasicRule Name
op_name ConTagZ
n_args RuleM CoreExpr
rm
  = BuiltinRule { ru_name :: RuleName
ru_name  = OccName -> RuleName
occNameFS (Name -> OccName
nameOccName Name
op_name),
                  ru_fn :: Name
ru_fn    = Name
op_name,
                  ru_nargs :: ConTagZ
ru_nargs = ConTagZ
n_args,
                  ru_try :: RuleFun
ru_try   = RuleM CoreExpr -> RuleFun
forall r.
RuleM r -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r
runRuleM RuleM CoreExpr
rm }

newtype RuleM r = RuleM
  { forall r.
RuleM r -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r
runRuleM :: RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r }
  deriving ((forall a b. (a -> b) -> RuleM a -> RuleM b)
-> (forall a b. a -> RuleM b -> RuleM a) -> Functor RuleM
forall a b. a -> RuleM b -> RuleM a
forall a b. (a -> b) -> RuleM a -> RuleM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RuleM a -> RuleM b
fmap :: forall a b. (a -> b) -> RuleM a -> RuleM b
$c<$ :: forall a b. a -> RuleM b -> RuleM a
<$ :: forall a b. a -> RuleM b -> RuleM a
Functor)

instance Applicative RuleM where
    pure :: forall a. a -> RuleM a
pure a
x = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a) -> RuleM a
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a)
 -> RuleM a)
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a)
-> RuleM a
forall a b. (a -> b) -> a -> b
$ \RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
    <*> :: forall a b. RuleM (a -> b) -> RuleM a -> RuleM b
(<*>) = RuleM (a -> b) -> RuleM a -> RuleM b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad RuleM where
  RuleM RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
f >>= :: forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
>>= a -> RuleM b
g
    = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe b) -> RuleM b
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe b)
 -> RuleM b)
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe b)
-> RuleM b
forall a b. (a -> b) -> a -> b
$ \RuleOpts
env InScopeEnv
iu Id
fn [CoreExpr]
args ->
              case RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
f RuleOpts
env InScopeEnv
iu Id
fn [CoreExpr]
args of
                Maybe a
Nothing -> Maybe b
forall a. Maybe a
Nothing
                Just a
r  -> RuleM b -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe b
forall r.
RuleM r -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r
runRuleM (a -> RuleM b
g a
r) RuleOpts
env InScopeEnv
iu Id
fn [CoreExpr]
args

instance