    {-
    (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
       , caseRules2
       )
    where

    import GHC.Prelude

    import GHC.Platform
    import GHC.Float

    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
       ( TyCon, tyConDataCons_maybe, tyConDataCons, tyConFamilySize
       , isEnumerationTyCon, isValidDTT2TyCon, isNewTyCon )
    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.Cmm.MachOp ( FMASign(..) )
    import GHC.Cmm.Type ( Width(..) )

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

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

    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
    DataToTagSmallOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 [ RuleM CoreExpr
    dataToTagRule ]
       PrimOp
    DataToTagLargeOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 [ 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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    int8Ops
                                        ]
       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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    word8Ops
                                        ]
       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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    int16Ops
                                        ]
       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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    word16Ops
                                        ]
       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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    int32Ops
                                        ]
       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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    word32Ops
                                        ]
       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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    int64Ops
                                        ]
       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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    word64Ops
                                        ]
       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 _ l1), Lit (LitNumber _ l2)] <- RuleM [CoreExpr]
    getArgs
                                            platform <- getPlatform
                                            let r = Integer
    l1 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    l2
                                            pure $ mkCoreUnboxedTuple
                                              [ Lit (if platformInIntRange platform r then zeroi platform else onei platform)
                                              , mkIntLitWrap platform (r `shiftR` platformWordSizeInBits platform)
                                              , mkIntLitWrap platform 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 <- RuleM Platform
    getPlatform
                                            pure $ mkCoreUnboxedTuple
                                              [ Lit (zeroi platform)
                                              , mkCoreApps (Var (primOpId IntSubOp))
                                                  [ Lit (zeroi platform)
                                                  , mkCoreApps (Var (primOpId IntSrlOp))
                                                    [ other
                                                    , mkIntLit platform (fromIntegral (platformWordSizeInBits platform - 1))
                                                    ]
                                                  ]
                                              , 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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    intOps
                                        ]
       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
                                        , NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    wordOps
                                        ]
       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
    CastWord64ToDoubleOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    1
          [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    unaryLit ((RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr)
    -> (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ \RuleOpts
    _env -> \case
             LitNumber LitNumType
    _ Integer
    n
                 | Double
    v <- Word64 -> Double
    castWord64ToDouble (Integer -> Word64
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)
                 -- we can't represent those float literals in Core until #18897 is fixed
                 , Bool -> Bool
    not (Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Double
    v Bool -> Bool -> Bool
    || Double -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite Double
    v Bool -> Bool -> Bool
    || Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNegativeZero Double
    v)
                 -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Double -> CoreExpr
    forall b. Double -> Expr b
    mkDoubleLitDouble Double
    v)
             Literal
    _   -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
          ]

       PrimOp
    CastWord32ToFloatOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    1
          [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    unaryLit ((RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr)
    -> (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ \RuleOpts
    _env -> \case
              LitNumber LitNumType
    _ Integer
    n
                  | Float
    v <- Word32 -> Float
    castWord32ToFloat (Integer -> Word32
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)
                  -- we can't represent those float literals in Core until #18897 is fixed
                  , Bool -> Bool
    not (Float -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Float
    v Bool -> Bool -> Bool
    || Float -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite Float
    v Bool -> Bool -> Bool
    || Float -> Bool
    forall a. RealFloat a => a -> Bool
    isNegativeZero Float
    v)
                  -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Float -> CoreExpr
    forall b. Float -> Expr b
    mkFloatLitFloat Float
    v)
              Literal
    _   -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
          ]

       PrimOp
    CastDoubleToWord64Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    1
          [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    unaryLit ((RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr)
    -> (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ \RuleOpts
    _env -> \case
             LitDouble Rational
    n -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Word64 -> CoreExpr
    forall b. Word64 -> Expr b
    mkWord64LitWord64 (Double -> Word64
    castDoubleToWord64 (Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational Rational
    n)))
             Literal
    _           -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
          ]

       PrimOp
    CastFloatToWord32Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    1
          [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    unaryLit ((RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr)
    -> (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ \RuleOpts
    _env -> \case
              LitFloat Rational
    n -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Word32 -> CoreExpr
    forall b. Word32 -> Expr b
    mkWord32LitWord32 (Float -> Word32
    castFloatToWord32 (Rational -> Float
    forall a. Fractional a => Rational -> a
    fromRational Rational
    n)))
              Literal
    _          -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
          ]

       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 lit] <- RuleM [CoreExpr]
    getArgs
                                                guard (litFitsInChar lit)
                                                liftLit 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  ]
       PrimOp
    FloatFMAdd        -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 (FMASign -> Width -> [RuleM CoreExpr]
    fmaRules FMASign
    FMAdd  Width
    W32)
       PrimOp
    FloatFMSub        -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 (FMASign -> Width -> [RuleM CoreExpr]
    fmaRules FMASign
    FMSub  Width
    W32)
       PrimOp
    FloatFNMAdd       -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 (FMASign -> Width -> [RuleM CoreExpr]
    fmaRules FMASign
    FNMAdd Width
    W32)
       PrimOp
    FloatFNMSub       -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 (FMASign -> Width -> [RuleM CoreExpr]
    fmaRules FMASign
    FNMSub Width
    W32)

                 -- 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  ]
       PrimOp
    DoubleFMAdd          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 (FMASign -> Width -> [RuleM CoreExpr]
    fmaRules FMASign
    FMAdd  Width
    W64)
       PrimOp
    DoubleFMSub          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 (FMASign -> Width -> [RuleM CoreExpr]
    fmaRules FMASign
    FMSub  Width
    W64)
       PrimOp
    DoubleFNMAdd         -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 (FMASign -> Width -> [RuleM CoreExpr]
    fmaRules FMASign
    FNMAdd Width
    W64)
       PrimOp
    DoubleFNMSub         -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
    mkPrimOpRule Name
    nm ConTagZ
    3 (FMASign -> Width -> [RuleM CoreExpr]
    fmaRules FMASign
    FNMSub Width
    W64)
                  -- 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 <- RuleM Platform
    getPlatform
                        ; return (if cmp True True
                                  then trueValInt  platform
                                  else falseValInt 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 <- RuleM Platform
    getPlatform
                  return $ Lit $ l platform

    retLitNoC :: (Platform -> Literal) -> RuleM CoreExpr
    retLitNoC :: (Platform -> Literal) -> RuleM CoreExpr
    retLitNoC Platform -> Literal
    l = do platform <- RuleM Platform
    getPlatform
                     let lit = Platform -> Literal
    l Platform
    platform
                     return $ mkCoreUnboxedTuple [Lit lit, Lit (zeroi 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 <- RuleM Platform
    getPlatform
      [e1, Lit (LitNumber LitNumInt shift_len)] <- getArgs

      bit_size <- case litNumBitSize platform 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 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

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

    -- | Constant folding rules for fused multiply-add operations.
    fmaRules :: FMASign -> Width -> [RuleM CoreExpr]
    fmaRules :: FMASign -> Width -> [RuleM CoreExpr]
    fmaRules FMASign
    signs Width
    width =
         [ FMASign -> Width -> RuleM CoreExpr
    fmaLit FMASign
    signs Width
    width
         , FMASign -> Width -> RuleM CoreExpr
    fmaZero_z FMASign
    signs Width
    width
         , FMASign -> Width -> RuleM CoreExpr
    fmaOne FMASign
    signs Width
    width ]

    -- | Compute @a * b + c@ when @a@, @b@, @c@ are all literals.
    fmaLit :: FMASign -> Width -> RuleM CoreExpr
    fmaLit :: FMASign -> Width -> RuleM CoreExpr
    fmaLit FMASign
    signs Width
    width = do
      env <- RuleM RuleOpts
    getRuleOpts
      [Lit l1, Lit l2, Lit l3] <- getArgs
      liftMaybe $
        op env
          (convFloating env l1)
          (convFloating env l2)
          (convFloating env l3)

      where
        op :: RuleOpts -> Literal -> Literal -> Literal -> Maybe CoreExpr
    op RuleOpts
    env Literal
    l1 Literal
    l2 Literal
    l3 =
          case Width
    width of
            Width
    W32
              | LitFloat Rational
    x <- Literal
    l1
              , LitFloat Rational
    y <- Literal
    l2
              , LitFloat Rational
    z <- Literal
    l3
              -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $ RuleOpts -> Rational -> CoreExpr
    mkFloatVal RuleOpts
    env (Rational -> CoreExpr) -> Rational -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                case FMASign
    signs of
                  FMASign
    FMAdd  -> Rational
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    y Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    + Rational
    z
                  FMASign
    FMSub  -> Rational
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    y Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    z
                  FMASign
    FNMAdd -> Rational -> Rational
    forall a. Num a => a -> a
    negate ( Rational
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    y ) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    + Rational
    z
                  FMASign
    FNMSub -> Rational -> Rational
    forall a. Num a => a -> a
    negate ( Rational
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    y ) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    z
            Width
    W64
              | LitDouble Rational
    x <- Literal
    l1
              , LitDouble Rational
    y <- Literal
    l2
              , LitDouble Rational
    z <- Literal
    l3
              -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $ RuleOpts -> Rational -> CoreExpr
    mkDoubleVal RuleOpts
    env (Rational -> CoreExpr) -> Rational -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                case FMASign
    signs of
                  FMASign
    FMAdd  -> Rational
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    y Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    + Rational
    z
                  FMASign
    FMSub  -> Rational
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    y Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    z
                  FMASign
    FNMAdd -> Rational -> Rational
    forall a. Num a => a -> a
    negate ( Rational
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    y ) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    + Rational
    z
                  FMASign
    FNMSub -> Rational -> Rational
    forall a. Num a => a -> a
    negate ( Rational
    x Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    y ) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    z
            Width
    _ -> Maybe CoreExpr
    forall a. Maybe a
    Nothing

    -- | @x * y + 0 = x * y@.
    fmaZero_z :: FMASign -> Width -> RuleM CoreExpr
    fmaZero_z :: FMASign -> Width -> RuleM CoreExpr
    fmaZero_z FMASign
    signs Width
    width = do
      [x, y, Lit z] <- RuleM [CoreExpr]
    getArgs
      let
        -- TODO: we should additionally check the sign of z.
        -- FMAdd, FNMAdd: should be -0.0.
        -- FMSub, FNMSub: should be +0.0.
        ok =
          case Width
    width of
            Width
    W32
              | LitFloat Rational
    0 <- Literal
    z
              -> Bool
    True
            Width
    W64
              | LitDouble Rational
    0 <- Literal
    z
              -> Bool
    True
            Width
    _ -> Bool
    False
        neg = case Width
    width of
          Width
    W32 ->  PrimOp
    FloatNegOp
          Width
    W64 -> PrimOp
    DoubleNegOp
          Width
    _   -> String -> PrimOp
    forall a. HasCallStack => String -> a
    panic String
    "fmaZero_xy: not Float# or Double#"
        mul = case Width
    width of
          Width
    W32 ->  PrimOp
    FloatMulOp
          Width
    W64 -> PrimOp
    DoubleMulOp
          Width
    _   -> String -> PrimOp
    forall a. HasCallStack => String -> a
    panic String
    "fmaZero_z: not Float# or Double#"
      if ok
      then return $ case signs of
        FMASign
    FMAdd  -> Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    mul) 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` CoreExpr
    y
        FMASign
    FMSub  -> Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    mul) 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` CoreExpr
    y
        FMASign
    FNMAdd -> Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    neg) CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` (Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    mul) 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` CoreExpr
    y)
        FMASign
    FNMSub -> Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    neg) CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` (Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    mul) 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` CoreExpr
    y)
      else mzero

    -- | @±1 * y + z ==> z ± y@ and @x * ±1 + z ==> z ± x@.
    fmaOne :: FMASign -> Width -> RuleM CoreExpr
    fmaOne :: FMASign -> Width -> RuleM CoreExpr
    fmaOne FMASign
    signs Width
    width = do
      [x, y, z] <- RuleM [CoreExpr]
    getArgs
      let
        posNegOne_maybe :: Rational -> Maybe Bool
        posNegOne_maybe Rational
    i
          | Rational
    i Rational -> Rational -> Bool
    forall a. Eq a => a -> a -> Bool
    == Rational
    1
          = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
          | Rational
    i Rational -> Rational -> Bool
    forall a. Eq a => a -> a -> Bool
    == -Rational
    1
          = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
          | Bool
    otherwise
          = Maybe Bool
    forall a. Maybe a
    Nothing
        ok =
          case Width
    width of
            Width
    W32
              | Lit (LitFloat Rational
    i) <- CoreExpr
    x
              , Just Bool
    sgn <- Rational -> Maybe Bool
    posNegOne_maybe Rational
    i
              -> (Bool, CoreExpr) -> Maybe (Bool, CoreExpr)
    forall a. a -> Maybe a
    Just (Bool
    sgn, CoreExpr
    y)
              | Lit (LitFloat Rational
    i) <- CoreExpr
    y
              , Just Bool
    sgn <- Rational -> Maybe Bool
    posNegOne_maybe Rational
    i
              -> (Bool, CoreExpr) -> Maybe (Bool, CoreExpr)
    forall a. a -> Maybe a
    Just (Bool
    sgn, CoreExpr
    x)
            Width
    W64
              | Lit (LitDouble Rational
    i) <- CoreExpr
    x
              , Just Bool
    sgn <- Rational -> Maybe Bool
    posNegOne_maybe Rational
    i
              -> (Bool, CoreExpr) -> Maybe (Bool, CoreExpr)
    forall a. a -> Maybe a
    Just (Bool
    sgn, CoreExpr
    y)
              | Lit (LitDouble Rational
    i) <- CoreExpr
    y
              , Just Bool
    sgn <- Rational -> Maybe Bool
    posNegOne_maybe Rational
    i
              -> (Bool, CoreExpr) -> Maybe (Bool, CoreExpr)
    forall a. a -> Maybe a
    Just (Bool
    sgn, CoreExpr
    x)
            Width
    _ -> Maybe (Bool, CoreExpr)
    forall a. Maybe a
    Nothing
        neg = case Width
    width of
          Width
    W32 ->  PrimOp
    FloatNegOp
          Width
    W64 -> PrimOp
    DoubleNegOp
          Width
    _   -> String -> PrimOp
    forall a. HasCallStack => String -> a
    panic String
    "fmaOne: not Float# or Double#"
        add = case Width
    width of
          Width
    W32 ->  PrimOp
    FloatAddOp
          Width
    W64 -> PrimOp
    DoubleAddOp
          Width
    _   -> String -> PrimOp
    forall a. HasCallStack => String -> a
    panic String
    "fmaOne: not Float# or Double#"
        sub = case Width
    width of
          Width
    W32 ->  PrimOp
    FloatSubOp
          Width
    W64 -> PrimOp
    DoubleSubOp
          Width
    _   -> String -> PrimOp
    forall a. HasCallStack => String -> a
    panic String
    "fmaOne: not Float# or Double#"
      case ok of
        Maybe (Bool, CoreExpr)
    Nothing  -> RuleM CoreExpr
    forall a. RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
        Just (Bool
    sgn, CoreExpr
    t) -> 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
    $
          if -- t + z
             |  ( FMASign
    signs FMASign -> FMASign -> Bool
    forall a. Eq a => a -> a -> Bool
    ==  FMASign
    FMAdd Bool -> Bool -> Bool
    && Bool
    sgn Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    False )
             Bool -> Bool -> Bool
    || ( FMASign
    signs FMASign -> FMASign -> Bool
    forall a. Eq a => a -> a -> Bool
    == FMASign
    FNMAdd Bool -> Bool -> Bool
    && Bool
    sgn Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    True  )
             -> Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    add) CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    t CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    z
             -- - t + z
             |  FMASign
    signs FMASign -> FMASign -> Bool
    forall a. Eq a => a -> a -> Bool
    ==  FMASign
    FMAdd
             Bool -> Bool -> Bool
    || FMASign
    signs FMASign -> FMASign -> Bool
    forall a. Eq a => a -> a -> Bool
    == FMASign
    FNMAdd
             -> Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    sub) CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    z CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    t
             -- t - z
             |  ( FMASign
    signs FMASign -> FMASign -> Bool
    forall a. Eq a => a -> a -> Bool
    ==  FMASign
    FMSub Bool -> Bool -> Bool
    && Bool
    sgn Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    False )
             Bool -> Bool -> Bool
    || ( FMASign
    signs FMASign -> FMASign -> Bool
    forall a. Eq a => a -> a -> Bool
    == FMASign
    FNMSub Bool -> Bool -> Bool
    && Bool
    sgn Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    True  )
             -> Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    sub) CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    t CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    z
             -- - t - z
             |  FMASign
    signs FMASign -> FMASign -> Bool
    forall a. Eq a => a -> a -> Bool
    ==  FMASign
    FMSub
             Bool -> Bool -> Bool
    || FMASign
    signs FMASign -> FMASign -> Bool
    forall a. Eq a => a -> a -> Bool
    == FMASign
    FNMSub
             -> Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    neg) CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` (Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    add) CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    t CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    z)
             | Bool
    otherwise
             -> String -> SDoc -> CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "fmaOne: non-exhaustive pattern match" (SDoc -> CoreExpr) -> SDoc -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                  [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "signs:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (FMASign -> String
    forall a. Show a => a -> String
    show FMASign
    signs)
                       , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "sign:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    sgn ]

    --------------------------
    {- 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 lit, expr] <- RuleM [CoreExpr]
    getArgs
           platform <- getPlatform
           do_lit_eq platform lit expr
      , do [expr, Lit lit] <- RuleM [CoreExpr]
    getArgs
           platform <- getPlatform
           do_lit_eq platform lit 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 <- RuleM Platform
    getPlatform
      [a, b] <- getArgs
      liftMaybe $ mkRuleFn platform op a 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 primop_id `App` e] <- RuleM [CoreExpr]
    getArgs
      matchPrimOpId primop primop_id
      return e

    subsumesPrimOp :: PrimOp -> PrimOp -> RuleM CoreExpr
    PrimOp
    this subsumesPrimOp :: PrimOp -> PrimOp -> RuleM CoreExpr
    `subsumesPrimOp` PrimOp
    that = do
      [Var primop_id `App` e] <- RuleM [CoreExpr]
    getArgs
      matchPrimOpId that primop_id
      return (Var (primOpId this) `App` e)

    subsumedByPrimOp :: PrimOp -> RuleM CoreExpr
    subsumedByPrimOp :: PrimOp -> RuleM CoreExpr
    subsumedByPrimOp PrimOp
    primop = do
      [e@(Var primop_id `App` _)] <- RuleM [CoreExpr]
    getArgs
      matchPrimOpId primop primop_id
      return 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 primop_id `App` x] <- RuleM [CoreExpr]
    getArgs
      matchPrimOpId narrow_primop primop_id
      return (Var (primOpId WordAndOp) `App` x `App` Lit (LitNumber LitNumWord 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 primop_id `App` x `App` y] <- RuleM [CoreExpr]
    getArgs
      matchPrimOpId and_primop primop_id
      let 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
    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
      g x y <|> g y x

    idempotent :: RuleM CoreExpr
    idempotent :: RuleM CoreExpr
    idempotent = do [e1, e2] <- RuleM [CoreExpr]
    getArgs
                    guard $ cheapEqExpr e1 e2
                    return 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
      [a,b] <- RuleM [CoreExpr]
    getArgs
      case (a,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 under
    "NoEffect" in Note [Classifying primop effects] (in GHC.Builtin.PrimOps)
    there is no safe way to rewrite the argument of I# such that it bottoms.

    Consequently we instead take advantage of the fact that the result of a
    large shift is unspecified (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 MonadFail RuleM where
        fail :: forall a. String -> RuleM a
    fail String
    _ = RuleM a
    forall a. RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    instance Alternative RuleM where
      empty :: forall a. RuleM a
    empty = (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]
    _ -> Maybe a
    forall a. Maybe a
    Nothing
      RuleM RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
    f1 <|> :: forall a. RuleM a -> RuleM a -> RuleM a
    <|> RuleM RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
    f2 = (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
    env InScopeEnv
    iu Id
    fn [CoreExpr]
    args ->
        RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
    f1 RuleOpts
    env InScopeEnv
    iu Id
    fn [CoreExpr]
    args Maybe a -> Maybe a -> Maybe a
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
    f2 RuleOpts
    env InScopeEnv
    iu Id
    fn [CoreExpr]
    args

    instance MonadPlus RuleM

    getPlatform :: RuleM Platform
    getPlatform :: RuleM Platform
    getPlatform = RuleOpts -> Platform
    roPlatform (RuleOpts -> Platform) -> RuleM RuleOpts -> RuleM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RuleM RuleOpts
    getRuleOpts

    getWordSize :: RuleM PlatformWordSize
    getWordSize :: RuleM PlatformWordSize
    getWordSize = Platform -> PlatformWordSize
    platformWordSize (Platform -> PlatformWordSize)
    -> RuleM Platform -> RuleM PlatformWordSize
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RuleM Platform
    getPlatform

    getRuleOpts :: RuleM RuleOpts
    getRuleOpts :: RuleM RuleOpts
    getRuleOpts = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe RuleOpts)
    -> RuleM RuleOpts
    forall r.
    (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
    RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe RuleOpts)
     -> RuleM RuleOpts)
    -> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe RuleOpts)
    -> RuleM RuleOpts
    forall a b. (a -> b) -> a -> b
    $ \RuleOpts
    rule_opts InScopeEnv
    _ Id
    _ [CoreExpr]
    _ -> RuleOpts -> Maybe RuleOpts
    forall a. a -> Maybe a
    Just RuleOpts
    rule_opts

    liftMaybe :: Maybe a -> RuleM a
    liftMaybe :: forall a. Maybe a -> RuleM a
    liftMaybe Maybe a
    Nothing = RuleM a
    forall a. RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
    liftMaybe (Just a
    x) = a -> RuleM a
    forall a. a -> RuleM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x

    liftLit :: (Literal -> Literal) -> RuleM CoreExpr
    liftLit :: (Literal -> Literal) -> RuleM CoreExpr
    liftLit Literal -> Literal
    f = (Platform -> Literal -> Literal) -> RuleM CoreExpr
    liftLitPlatform ((Literal -> Literal) -> Platform -> Literal -> Literal
    forall a b. a -> b -> a
    const Literal -> Literal
    f)

    liftLitPlatform :: (Platform -> Literal -> Literal) -> RuleM CoreExpr
    liftLitPlatform :: (Platform -> Literal -> Literal) -> RuleM CoreExpr
    liftLitPlatform Platform -> Literal -> Literal
    f = do
      platform <- RuleM Platform
    getPlatform
      [Lit lit] <- getArgs
      return $ Lit (f platform lit)

    removeOp32 :: RuleM CoreExpr
    removeOp32 :: RuleM CoreExpr
    removeOp32 = do
      platform <- RuleM Platform
    getPlatform
      case platformWordSize platform of
        PlatformWordSize
    PW4 -> do
          [e] <- RuleM [CoreExpr]
    getArgs
          return e
        PlatformWordSize
    PW8 ->
          RuleM CoreExpr
    forall a. RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    getArgs :: RuleM [CoreExpr]
    getArgs :: RuleM [CoreExpr]
    getArgs = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe [CoreExpr])
    -> RuleM [CoreExpr]
    forall r.
    (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
    RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe [CoreExpr])
     -> RuleM [CoreExpr])
    -> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe [CoreExpr])
    -> RuleM [CoreExpr]
    forall a b. (a -> b) -> a -> b
    $ \RuleOpts
    _ InScopeEnv
    _ Id
    _ [CoreExpr]
    args -> [CoreExpr] -> Maybe [CoreExpr]
    forall a. a -> Maybe a
    Just [CoreExpr]
    args

    getInScopeEnv :: RuleM InScopeEnv
    getInScopeEnv :: RuleM InScopeEnv
    getInScopeEnv = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe InScopeEnv)
    -> RuleM InScopeEnv
    forall r.
    (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
    RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe InScopeEnv)
     -> RuleM InScopeEnv)
    -> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe InScopeEnv)
    -> RuleM InScopeEnv
    forall a b. (a -> b) -> a -> b
    $ \RuleOpts
    _ InScopeEnv
    iu Id
    _ [CoreExpr]
    _ -> InScopeEnv -> Maybe InScopeEnv
    forall a. a -> Maybe a
    Just InScopeEnv
    iu

    getFunction :: RuleM Id
    getFunction :: RuleM Id
    getFunction = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe Id)
    -> RuleM Id
    forall r.
    (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
    RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe Id)
     -> RuleM Id)
    -> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe Id)
    -> RuleM Id
    forall a b. (a -> b) -> a -> b
    $ \RuleOpts
    _ InScopeEnv
    _ Id
    fn [CoreExpr]
    _ -> Id -> Maybe Id
    forall a. a -> Maybe a
    Just Id
    fn

    isLiteral :: CoreExpr -> RuleM Literal
    isLiteral :: CoreExpr -> RuleM Literal
    isLiteral CoreExpr
    e = do
        env <- RuleM InScopeEnv
    getInScopeEnv
        case exprIsLiteral_maybe env e of
            Maybe Literal
    Nothing -> RuleM Literal
    forall a. RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            Just Literal
    l  -> Literal -> RuleM Literal
    forall a. a -> RuleM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Literal
    l

    -- | Match BigNat#, Integer and Natural literals
    isBignumLiteral :: CoreExpr -> RuleM Integer
    isBignumLiteral :: CoreExpr -> RuleM Integer
    isBignumLiteral CoreExpr
    e = CoreExpr -> RuleM Integer
    isNumberLiteral CoreExpr
    e RuleM Integer -> RuleM Integer -> RuleM Integer
    forall a. RuleM a -> RuleM a -> RuleM a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> CoreExpr -> RuleM Integer
    isIntegerLiteral CoreExpr
    e RuleM Integer -> RuleM Integer -> RuleM Integer
    forall a. RuleM a -> RuleM a -> RuleM a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> CoreExpr -> RuleM Integer
    isNaturalLiteral CoreExpr
    e

    -- | Match numeric literals
    isNumberLiteral :: CoreExpr -> RuleM Integer
    isNumberLiteral :: CoreExpr -> RuleM Integer
    isNumberLiteral CoreExpr
    e = CoreExpr -> RuleM Literal
    isLiteral CoreExpr
    e RuleM Literal -> (Literal -> RuleM Integer) -> RuleM Integer
    forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      LitNumber LitNumType
    _ Integer
    x -> Integer -> RuleM Integer
    forall a. a -> RuleM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Integer
    x
      Literal
    _             -> RuleM Integer
    forall a. RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    -- | Match the application of a DataCon to a numeric literal.
    --
    -- Can be used to match e.g.:
    --  IS 123#
    --  IP bigNatLiteral
    --  W# 123##
    isLitNumConApp :: CoreExpr -> RuleM (DataCon,Integer)
    isLitNumConApp :: CoreExpr -> RuleM (DataCon, Integer)
    isLitNumConApp CoreExpr
    e = do
      env <- RuleM InScopeEnv
    getInScopeEnv
      case exprIsConApp_maybe env e of
        Just (InScopeSet
    _env,[FloatBind]
    _fb,DataCon
    dc,[Type]
    _tys,[CoreExpr
    arg]) -> case InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    arg of
          Just (LitNumber LitNumType
    _ Integer
    i) -> (DataCon, Integer) -> RuleM (DataCon, Integer)
    forall a. a -> RuleM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (DataCon
    dc,Integer
    i)
          Maybe Literal
    _                    -> RuleM (DataCon, Integer)
    forall a. RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
        Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
    _ -> RuleM (DataCon, Integer)
    forall a. RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    isIntegerLiteral :: CoreExpr -> RuleM Integer
    isIntegerLiteral :: CoreExpr -> RuleM Integer
    isIntegerLiteral CoreExpr
    e = do
      (dc,i) <- CoreExpr -> RuleM (DataCon, Integer)
    isLitNumConApp CoreExpr
    e
      if | dc == integerISDataCon -> pure i
         | dc == integerINDataCon -> pure (negate i)
         | dc == integerIPDataCon -> pure i
         | otherwise              -> mzero

    isBigIntegerLiteral :: CoreExpr -> RuleM Integer
    isBigIntegerLiteral :: CoreExpr -> RuleM Integer
    isBigIntegerLiteral CoreExpr
    e = do
      (dc,i) <- CoreExpr -> RuleM (DataCon, Integer)
    isLitNumConApp CoreExpr
    e
      if | dc == integerINDataCon -> pure (negate i)
         | dc == integerIPDataCon -> pure i
         | otherwise              -> mzero

    isNaturalLiteral :: CoreExpr -> RuleM Integer
    isNaturalLiteral :: CoreExpr -> RuleM Integer
    isNaturalLiteral CoreExpr
    e = do
      (dc,i) <- CoreExpr -> RuleM (DataCon, Integer)
    isLitNumConApp CoreExpr
    e
      if | dc == naturalNSDataCon -> pure i
         | dc == naturalNBDataCon -> pure i
         | otherwise              -> mzero

    -- return the n-th argument of this rule, if it is a literal
    -- argument indices start from 0
    getLiteral :: Int -> RuleM Literal
    getLiteral :: ConTagZ -> RuleM Literal
    getLiteral ConTagZ
    n = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe Literal)
    -> RuleM Literal
    forall r.
    (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
    RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe Literal)
     -> RuleM Literal)
    -> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe Literal)
    -> RuleM Literal
    forall a b. (a -> b) -> a -> b
    $ \RuleOpts
    _ InScopeEnv
    _ Id
    _ [CoreExpr]
    exprs -> case ConTagZ -> [CoreExpr] -> [CoreExpr]
    forall a. ConTagZ -> [a] -> [a]
    drop ConTagZ
    n [CoreExpr]
    exprs of
      (Lit Literal
    l:[CoreExpr]
    _) -> Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just Literal
    l
      [CoreExpr]
    _ -> Maybe Literal
    forall a. Maybe a
    Nothing

    unaryLit :: (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    unaryLit :: (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    unaryLit RuleOpts -> Literal -> Maybe CoreExpr
    op = do
      env <- RuleM RuleOpts
    getRuleOpts
      [Lit l] <- getArgs
      liftMaybe $ op env (convFloating env l)

    binaryLit :: (RuleOpts -> Literal -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
    binaryLit :: (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
    -> RuleM CoreExpr
    binaryLit RuleOpts -> Literal -> Literal -> Maybe CoreExpr
    op = do
      env <- RuleM RuleOpts
    getRuleOpts
      [Lit l1, Lit l2] <- getArgs
      liftMaybe $ op env (convFloating env l1) (convFloating env l2)

    binaryCmpLit :: (forall a . Ord a => a -> a -> Bool) -> RuleM CoreExpr
    binaryCmpLit :: (forall a. Ord a => a -> a -> Bool) -> RuleM CoreExpr
    binaryCmpLit forall a. Ord a => a -> a -> Bool
    op = do
      platform <- RuleM Platform
    getPlatform
      binaryLit (\RuleOpts
    _ -> Platform
    -> (forall a. Ord a => a -> a -> Bool)
    -> Literal
    -> Literal
    -> Maybe CoreExpr
    cmpOp Platform
    platform a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    op)

    leftIdentity :: Literal -> RuleM CoreExpr
    leftIdentity :: Literal -> RuleM CoreExpr
    leftIdentity Literal
    id_lit = (Platform -> Literal) -> RuleM CoreExpr
    leftIdentityPlatform (Literal -> Platform -> Literal
    forall a b. a -> b -> a
    const Literal
    id_lit)

    rightIdentity :: Literal -> RuleM CoreExpr
    rightIdentity :: Literal -> RuleM CoreExpr
    rightIdentity Literal
    id_lit = (Platform -> Literal) -> RuleM CoreExpr
    rightIdentityPlatform (Literal -> Platform -> Literal
    forall a b. a -> b -> a
    const Literal
    id_lit)

    identity :: Literal -> RuleM CoreExpr
    identity :: Literal -> RuleM CoreExpr
    identity Literal
    lit = Literal -> RuleM CoreExpr
    leftIdentity Literal
    lit RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
    forall a. RuleM a -> RuleM a -> RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Literal -> RuleM CoreExpr
    rightIdentity Literal
    lit

    leftIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    leftIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    leftIdentityPlatform Platform -> Literal
    id_lit = do
      platform <- RuleM Platform
    getPlatform
      [Lit l1, e2] <- getArgs
      guard $ l1 == id_lit platform
      return e2

    -- | Left identity rule for PrimOps like 'IntAddC' and 'WordAddC', where, in
    -- addition to the result, we have to indicate that no carry/overflow occurred.
    leftIdentityCPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    leftIdentityCPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    leftIdentityCPlatform Platform -> Literal
    id_lit = do
      platform <- RuleM Platform
    getPlatform
      [Lit l1, e2] <- getArgs
      guard $ l1 == id_lit platform
      let no_c = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Platform -> Literal
    zeroi Platform
    platform)
      return (mkCoreUnboxedTuple [e2, no_c])

    rightIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    rightIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    rightIdentityPlatform Platform -> Literal
    id_lit = do
      platform <- RuleM Platform
    getPlatform
      [e1, Lit l2] <- getArgs
      guard $ l2 == id_lit platform
      return e1

    -- | Right identity rule for PrimOps like 'IntSubC' and 'WordSubC', where, in
    -- addition to the result, we have to indicate that no carry/overflow occurred.
    rightIdentityCPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    rightIdentityCPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    rightIdentityCPlatform Platform -> Literal
    id_lit = do
      platform <- RuleM Platform
    getPlatform
      [e1, Lit l2] <- getArgs
      guard $ l2 == id_lit platform
      let no_c = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Platform -> Literal
    zeroi Platform
    platform)
      return (mkCoreUnboxedTuple [e1, no_c])

    identityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    identityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    identityPlatform Platform -> Literal
    lit =
      (Platform -> Literal) -> RuleM CoreExpr
    leftIdentityPlatform Platform -> Literal
    lit RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
    forall a. RuleM a -> RuleM a -> RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` (Platform -> Literal) -> RuleM CoreExpr
    rightIdentityPlatform Platform -> Literal
    lit

    -- | Identity rule for PrimOps like 'IntAddC' and 'WordAddC', where, in addition
    -- to the result, we have to indicate that no carry/overflow occurred.
    identityCPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    identityCPlatform :: (Platform -> Literal) -> RuleM CoreExpr
    identityCPlatform Platform -> Literal
    lit =
      (Platform -> Literal) -> RuleM CoreExpr
    leftIdentityCPlatform Platform -> Literal
    lit RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
    forall a. RuleM a -> RuleM a -> RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` (Platform -> Literal) -> RuleM CoreExpr
    rightIdentityCPlatform Platform -> Literal
    lit

    leftZero :: RuleM CoreExpr
    leftZero :: RuleM CoreExpr
    leftZero = do
      [Lit l1, _] <- RuleM [CoreExpr]
    getArgs
      guard $ isZeroLit l1
      return $ Lit l1

    rightZero :: RuleM CoreExpr
    rightZero :: RuleM CoreExpr
    rightZero = do
      [_, Lit l2] <- RuleM [CoreExpr]
    getArgs
      guard $ isZeroLit l2
      return $ Lit l2

    zeroElem :: RuleM CoreExpr
    zeroElem :: RuleM CoreExpr
    zeroElem = RuleM CoreExpr
    leftZero RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
    forall a. RuleM a -> RuleM a -> RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` RuleM CoreExpr
    rightZero

    equalArgs :: RuleM ()
    equalArgs :: RuleM ()
    equalArgs = do
      [e1, e2] <- RuleM [CoreExpr]
    getArgs
      guard $ e1 `cheapEqExpr` e2

    nonZeroLit :: Int -> RuleM ()
    nonZeroLit :: ConTagZ -> RuleM ()
    nonZeroLit ConTagZ
    n = ConTagZ -> RuleM Literal
    getLiteral ConTagZ
    n RuleM Literal -> (Literal -> RuleM ()) -> RuleM ()
    forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> RuleM ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> RuleM ()) -> (Literal -> Bool) -> Literal -> RuleM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Bool
    not (Bool -> Bool) -> (Literal -> Bool) -> Literal -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Literal -> Bool
    isZeroLit

    oneLit :: Int -> RuleM ()
    oneLit :: ConTagZ -> RuleM ()
    oneLit ConTagZ
    n = ConTagZ -> RuleM Literal
    getLiteral ConTagZ
    n RuleM Literal -> (Literal -> RuleM ()) -> RuleM ()
    forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> RuleM ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> RuleM ()) -> (Literal -> Bool) -> Literal -> RuleM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Literal -> Bool
    isOneLit

    lift_bits_op :: forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
    lift_bits_op :: forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
    lift_bits_op a -> Integer
    op = do
      platform <- RuleM Platform
    getPlatform
      [Lit (LitNumber _ l)] <- getArgs
      pure $ mkWordLit platform $ op (fromInteger l :: a)

    pop_count :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
    pop_count :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
    pop_count = forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
    lift_bits_op @a (ConTagZ -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ConTagZ -> Integer) -> (a -> ConTagZ) -> a -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ConTagZ
    forall a. Bits a => a -> ConTagZ
    popCount)

    ctz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
    ctz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
    ctz = forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
    lift_bits_op @a (ConTagZ -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ConTagZ -> Integer) -> (a -> ConTagZ) -> a -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ConTagZ
    forall b. FiniteBits b => b -> ConTagZ
    countTrailingZeros)

    clz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
    clz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
    clz = forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
    lift_bits_op @a (ConTagZ -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ConTagZ -> Integer) -> (a -> ConTagZ) -> a -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ConTagZ
    forall b. FiniteBits b => b -> ConTagZ
    countLeadingZeros)

    -- When excess precision is not requested, cut down the precision of the
    -- Rational value to that of Float/Double. We confuse host architecture
    -- and target architecture here, but it's convenient (and wrong :-).
    convFloating :: RuleOpts -> Literal -> Literal
    convFloating :: RuleOpts -> Literal -> Literal
    convFloating RuleOpts
    env (LitFloat  Rational
    f) | Bool -> Bool
    not (RuleOpts -> Bool
    roExcessRationalPrecision RuleOpts
    env) =
       Rational -> Literal
    LitFloat  (Float -> Rational
    forall a. Real a => a -> Rational
    toRational (Rational -> Float
    forall a. Fractional a => Rational -> a
    fromRational Rational
    f :: Float ))
    convFloating RuleOpts
    env (LitDouble Rational
    d) | Bool -> Bool
    not (RuleOpts -> Bool
    roExcessRationalPrecision RuleOpts
    env) =
       Rational -> Literal
    LitDouble (Double -> Rational
    forall a. Real a => a -> Rational
    toRational (Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational Rational
    d :: Double))
    convFloating RuleOpts
    _ Literal
    l = Literal
    l

    guardFloatDiv :: RuleM ()
    guardFloatDiv :: RuleM ()
    guardFloatDiv = do
      [Lit (LitFloat f1), Lit (LitFloat f2)] <- RuleM [CoreExpr]
    getArgs
      guard $ (f1 /=0 || f2 > 0) -- see Note [negative zero]
           && f2 /= 0            -- avoid NaN and Infinity/-Infinity

    guardDoubleDiv :: RuleM ()
    guardDoubleDiv :: RuleM ()
    guardDoubleDiv = do
      [Lit (LitDouble d1), Lit (LitDouble d2)] <- RuleM [CoreExpr]
    getArgs
      guard $ (d1 /=0 || d2 > 0) -- see Note [negative zero]
           && d2 /= 0            -- avoid NaN and Infinity/-Infinity
    -- Note [negative zero]
    -- ~~~~~~~~~~~~~~~~~~~~
    -- Avoid (0 / -d), otherwise 0/(-1) reduces to
    -- zero, but we might want to preserve the negative zero here which
    -- is representable in Float/Double but not in (normalised)
    -- Rational. (#3676) Perhaps we should generate (0 :% (-1)) instead?

    strengthReduction :: Literal -> PrimOp -> RuleM CoreExpr
    strengthReduction :: Literal -> PrimOp -> RuleM CoreExpr
    strengthReduction Literal
    two_lit PrimOp
    add_op = do -- Note [Strength reduction]
      arg <- [RuleM CoreExpr] -> RuleM CoreExpr
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum [ do [arg, Lit mult_lit] <- RuleM [CoreExpr]
    getArgs
                       guard (mult_lit == two_lit)
                       return arg
                  , do [Lit mult_lit, arg] <- RuleM [CoreExpr]
    getArgs
                       guard (mult_lit == two_lit)
                       return arg ]
      return $ Var (primOpId add_op) `App` arg `App` arg

    -- Note [Strength reduction]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~
    -- This rule turns floating point multiplications of the form 2.0 * x and
    -- x * 2.0 into x + x addition, because addition costs less than multiplication.
    -- See #7116

    -- Note [What's true and false]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- trueValInt and falseValInt represent true and false values returned by
    -- comparison primops for Char, Int, Word, Integer, Double, Float and Addr.
    -- True is represented as an unboxed 1# literal, while false is represented
    -- as 0# literal.
    -- We still need Bool data constructors (True and False) to use in a rule
    -- for constant folding of equal Strings

    trueValInt, falseValInt :: Platform -> Expr CoreBndr
    trueValInt :: Platform -> CoreExpr
    trueValInt  Platform
    platform = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> Literal
    onei  Platform
    platform -- see Note [What's true and false]
    falseValInt :: Platform -> CoreExpr
    falseValInt Platform
    platform = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> Literal
    zeroi Platform
    platform

    trueValBool, falseValBool :: Expr CoreBndr
    trueValBool :: CoreExpr
    trueValBool   = Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    trueDataConId -- see Note [What's true and false]
    falseValBool :: CoreExpr
    falseValBool  = Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    falseDataConId

    ltVal, eqVal, gtVal :: Expr CoreBndr
    ltVal :: CoreExpr
    ltVal = Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    ordLTDataConId
    eqVal :: CoreExpr
    eqVal = Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    ordEQDataConId
    gtVal :: CoreExpr
    gtVal = Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    ordGTDataConId

    mkIntVal :: Platform -> Integer -> Expr CoreBndr
    mkIntVal :: Platform -> Integer -> CoreExpr
    mkIntVal Platform
    platform Integer
    i = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Platform -> Integer -> Literal
    mkLitInt Platform
    platform Integer
    i)
    mkFloatVal :: RuleOpts -> Rational -> Expr CoreBndr
    mkFloatVal :: RuleOpts -> Rational -> CoreExpr
    mkFloatVal RuleOpts
    env Rational
    f = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (RuleOpts -> Literal -> Literal
    convFloating RuleOpts
    env (Rational -> Literal
    LitFloat  Rational
    f))
    mkDoubleVal :: RuleOpts -> Rational -> Expr CoreBndr
    mkDoubleVal :: RuleOpts -> Rational -> CoreExpr
    mkDoubleVal RuleOpts
    env Rational
    d = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (RuleOpts -> Literal -> Literal
    convFloating RuleOpts
    env (Rational -> Literal
    LitDouble Rational
    d))

    matchPrimOpId :: PrimOp -> Id -> RuleM ()
    matchPrimOpId :: PrimOp -> Id -> RuleM ()
    matchPrimOpId PrimOp
    op Id
    id = do
      op' <- Maybe PrimOp -> RuleM PrimOp
    forall a. Maybe a -> RuleM a
    liftMaybe (Maybe PrimOp -> RuleM PrimOp) -> Maybe PrimOp -> RuleM PrimOp
    forall a b. (a -> b) -> a -> b
    $ Id -> Maybe PrimOp
    isPrimOpId_maybe Id
    id
      guard $ op == op'

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Special rules for seq, tagToEnum, dataToTag}
    *                                                                      *
    ************************************************************************

    Note [tagToEnum#]
    ~~~~~~~~~~~~~~~~~
    Nasty check to ensure that tagToEnum# is applied to a type that is an
    enumeration TyCon.  Unification may refine the type later, but this
    check won't see that, alas.  It's crude but it works.

    Here's are two cases that should fail
            f :: forall a. a
            f = tagToEnum# 0        -- Can't do tagToEnum# at a type variable

            g :: Int
            g = tagToEnum# 0        -- Int is not an enumeration

    We used to make this check in the type inference engine, but it's quite
    ugly to do so, because the delayed constraint solving means that we don't
    really know what's going on until the end. It's very much a corner case
    because we don't expect the user to call tagToEnum# at all; we merely
    generate calls in derived instances of Enum.  So we compromise: a
    rewrite rule rewrites a bad instance of tagToEnum# to an error call,
    and emits a warning.
    -}

    tagToEnumRule :: RuleM CoreExpr
    -- If     data T a = A | B | C
    -- then   tagToEnum# (T ty) 2# -->  B ty
    tagToEnumRule :: RuleM CoreExpr
    tagToEnumRule = do
      [Type ty, Lit (LitNumber LitNumInt i)] <- RuleM [CoreExpr]
    getArgs
      case splitTyConApp_maybe ty of
        Just (TyCon
    tycon, [Type]
    tc_args) | TyCon -> Bool
    isEnumerationTyCon TyCon
    tycon -> do
          let tag :: ConTagZ
    tag = Integer -> ConTagZ
    forall a. Num a => Integer -> a
    fromInteger Integer
    i
              correct_tag :: DataCon -> Bool
    correct_tag DataCon
    dc = (DataCon -> ConTagZ
    dataConTagZ DataCon
    dc) ConTagZ -> ConTagZ -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConTagZ
    tag
          (dc:rest) <- [DataCon] -> RuleM [DataCon]
    forall a. a -> RuleM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DataCon] -> RuleM [DataCon]) -> [DataCon] -> RuleM [DataCon]
    forall a b. (a -> b) -> a -> b
    $ (DataCon -> Bool) -> [DataCon] -> [DataCon]
    forall a. (a -> Bool) -> [a] -> [a]
    filter DataCon -> Bool
    correct_tag (TyCon -> Maybe [DataCon]
    tyConDataCons_maybe TyCon
    tycon Maybe [DataCon] -> [DataCon] -> [DataCon]
    forall a. Maybe a -> a -> a
    `orElse` [])
          massert (null rest)
          return $ mkTyApps (Var (dataConWorkId dc)) tc_args

        -- See Note [tagToEnum#]
        Maybe (TyCon, [Type])
    _ -> Bool -> String -> SDoc -> RuleM CoreExpr -> RuleM CoreExpr
    forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
    warnPprTrace Bool
    True String
    "tagToEnum# on non-enumeration type" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) (RuleM CoreExpr -> RuleM CoreExpr)
    -> RuleM CoreExpr -> RuleM CoreExpr
    forall a b. (a -> b) -> a -> b
    $
             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
    $ Type -> String -> CoreExpr
    mkImpossibleExpr Type
    ty String
    "tagToEnum# on non-enumeration type"

    ------------------------------
    dataToTagRule :: RuleM CoreExpr
    -- Used for both dataToTagSmall# and dataToTagLarge#.
    -- See Note [DataToTag overview] in GHC.Tc.Instance.Class,
    -- particularly wrinkle DTW5.
    dataToTagRule :: RuleM CoreExpr
    dataToTagRule = RuleM CoreExpr
    a RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
    forall a. RuleM a -> RuleM a -> RuleM a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` RuleM CoreExpr
    b
      where
        -- dataToTag (tagToEnum x)   ==>   x
        a :: RuleM CoreExpr
    a = do
          [Type _lev, Type ty1, Var tag_to_enum `App` Type ty2 `App` tag] <- RuleM [CoreExpr]
    getArgs
          guard $ tag_to_enum `hasKey` tagToEnumKey
          guard $ ty1 `eqType` ty2
          return tag

        -- dataToTag (K e1 e2)  ==>   tag-of K
        -- This also works (via exprIsConApp_maybe) for
        --   dataToTag x
        -- where x's unfolding is a constructor application
        b :: RuleM CoreExpr
    b = do
          platform <- RuleM Platform
    getPlatform
          [_lev, _ty, val_arg] <- getArgs
          in_scope <- getInScopeEnv
          (_,floats, dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg
          massert (not (isNewTyCon (dataConTyCon dc)))
          return $ wrapFloats floats (mkIntVal platform (toInteger (dataConTagZ dc)))

    {- *********************************************************************
    *                                                                      *
                 unsafeEqualityProof
    *                                                                      *
    ********************************************************************* -}

    -- unsafeEqualityProof k t t  ==>  UnsafeRefl (Refl t)
    -- That is, if the two types are equal, it's not unsafe!

    unsafeEqualityProofRule :: RuleM CoreExpr
    unsafeEqualityProofRule :: RuleM CoreExpr
    unsafeEqualityProofRule
      = do { [Type rep, Type t1, Type t2] <- RuleM [CoreExpr]
    getArgs
           ; guard (t1 `eqType` t2)
           ; fn <- getFunction
           ; let (_, ue) = splitForAllTyCoVars (idType fn)
                 tc      = HasDebugCallStack => Type -> TyCon
    Type -> TyCon
    tyConAppTyCon Type
    ue  -- tycon:    UnsafeEquality
                 (dc:_)  = tyConDataCons tc  -- data con: UnsafeRefl
                 -- UnsafeRefl :: forall (r :: RuntimeRep) (a :: TYPE r).
                 --               UnsafeEquality r a a
           ; return (mkTyApps (Var (dataConWrapId dc)) [rep, t1]) }

    {- *********************************************************************
    *                                                                      *
                 Rules for seq# and spark#
    *                                                                      *
    ********************************************************************* -}

    {- Note [seq# magic]
    ~~~~~~~~~~~~~~~~~~~~
    The primop
       seq# :: forall a s . a -> State# s -> (# State# s, a #)

    is /not/ the same as the Prelude function seq :: a -> b -> b
    as you can see from its type.  In fact, seq# is the implementation
    mechanism for 'evaluate'

       evaluate :: a -> IO a
       evaluate a = IO $ \s -> seq# a s

    The semantics of seq# is
      * evaluate its first argument
      * and return it

    Things to note

    * Why do we need a primop at all?  That is, instead of
          case seq# x s of (# x, s #) -> blah
      why not instead say this?
          case x of { DEFAULT -> blah }

      Reason (see #5129): if we saw
        catch# (\s -> case x of { DEFAULT -> raiseIO# exn s }) handler

      then we'd drop the 'case x' because the body of the case is bottom
      anyway. But we don't want to do that; the whole /point/ of
      seq#/evaluate is to evaluate 'x' first in the IO monad.

      In short, we /always/ evaluate the first argument and never
      just discard it.

    * Why return the value?  So that we can control sharing of seq'd
      values: in
         let x = e in x `seq` ... x ...
      We don't want to inline x, so better to represent it as
           let x = e in case seq# x RW of (# _, x' #) -> ... x' ...
      also it matches the type of rseq in the Eval monad.

    Implementing seq#.  The compiler has magic for SeqOp in

    - GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# <whnf> s)

    - GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq#

    - Simplify.addEvals records evaluated-ness for the result; see
      Note [Adding evaluatedness info to pattern-bound variables]
      in GHC.Core.Opt.Simplify.Iteration

    - Likewise, GHC.Stg.InferTags.inferTagExpr knows that seq# returns a
      properly-tagged pointer inside of its unboxed-tuple result.
    -}

    seqRule :: RuleM CoreExpr
    seqRule :: RuleM CoreExpr
    seqRule = do
      [Type _ty_a, Type _ty_s, a, s] <- RuleM [CoreExpr]
    getArgs
      guard $ exprIsHNF a
      return $ mkCoreUnboxedTuple [s, a]

    -- spark# :: forall a s . a -> State# s -> (# State# s, a #)
    sparkRule :: RuleM CoreExpr
    sparkRule :: RuleM CoreExpr
    sparkRule = RuleM CoreExpr
    seqRule -- reduce on HNF, just the same
      -- XXX perhaps we shouldn't do this, because a spark eliminated by
      -- this rule won't be counted as a dud at runtime?

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Built in rules}
    *                                                                      *
    ************************************************************************

    Note [Scoping for Builtin rules]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When compiling a (base-package) module that defines one of the
    functions mentioned in the RHS of a built-in rule, there's a danger
    that we'll see

            f = ...(eq String x)....

            ....and lower down...

            eqString = ...

    Then a rewrite would give

            f = ...(eqString x)...
            ....and lower down...
            eqString = ...

    and lo, eqString is not in scope.  This only really matters when we
    get to code generation.  But the occurrence analyser does a GlomBinds
    step when necessary, that does a new SCC analysis on the whole set of
    bindings (see occurAnalysePgm), which sorts out the dependency, so all
    is fine.
    -}

    builtinRules :: [CoreRule]
    -- Rules for non-primops that can't be expressed using a RULE pragma
    builtinRules :: [CoreRule]
    builtinRules
      = [BuiltinRule { ru_name :: RuleName
    ru_name = String -> RuleName
    fsLit String
    "CStringFoldrLit",
                       ru_fn :: Name
    ru_fn = Name
    unpackCStringFoldrName,
                       ru_nargs :: ConTagZ
    ru_nargs = ConTagZ
    4, ru_try :: RuleFun
    ru_try = RuleFun
    match_cstring_foldr_lit_C },
         BuiltinRule { ru_name :: RuleName
    ru_name = String -> RuleName
    fsLit String
    "CStringFoldrLitUtf8",
                       ru_fn :: Name
    ru_fn = Name
    unpackCStringFoldrUtf8Name,
                       ru_nargs :: ConTagZ
    ru_nargs = ConTagZ
    4, ru_try :: RuleFun
    ru_try = RuleFun
    match_cstring_foldr_lit_utf8 },
         BuiltinRule { ru_name :: RuleName
    ru_name = String -> RuleName
    fsLit String
    "CStringAppendLit",
                       ru_fn :: Name
    ru_fn = Name
    unpackCStringAppendName,
                       ru_nargs :: ConTagZ
    ru_nargs = ConTagZ
    2, ru_try :: RuleFun
    ru_try = RuleFun
    match_cstring_append_lit_C },
         BuiltinRule { ru_name :: RuleName
    ru_name = String -> RuleName
    fsLit String
    "CStringAppendLitUtf8",
                       ru_fn :: Name
    ru_fn = Name
    unpackCStringAppendUtf8Name,
                       ru_nargs :: ConTagZ
    ru_nargs = ConTagZ
    2, ru_try :: RuleFun
    ru_try = RuleFun
    match_cstring_append_lit_utf8 },
         BuiltinRule { ru_name :: RuleName
    ru_name = String -> RuleName
    fsLit String
    "EqString", ru_fn :: Name
    ru_fn = Name
    eqStringName,
                       ru_nargs :: ConTagZ
    ru_nargs = ConTagZ
    2, ru_try :: RuleFun
    ru_try = RuleFun
    match_eq_string },
         BuiltinRule { ru_name :: RuleName
    ru_name = String -> RuleName
    fsLit String
    "CStringLength", ru_fn :: Name
    ru_fn = Name
    cstringLengthName,
                       ru_nargs :: ConTagZ
    ru_nargs = ConTagZ
    1, ru_try :: RuleFun
    ru_try = RuleFun
    match_cstring_length },
         BuiltinRule { ru_name :: RuleName
    ru_name = String -> RuleName
    fsLit String
    "Inline", ru_fn :: Name
    ru_fn = Name
    inlineIdName,
                       ru_nargs :: ConTagZ
    ru_nargs = ConTagZ
    2, ru_try :: RuleFun
    ru_try = \RuleOpts
    _ InScopeEnv
    _ Id
    _ -> [CoreExpr] -> Maybe CoreExpr
    match_inline },

         Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkBasicRule Name
    unsafeEqualityProofName ConTagZ
    3 RuleM CoreExpr
    unsafeEqualityProofRule,

         Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkBasicRule Name
    divIntName ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ [RuleM CoreExpr] -> RuleM CoreExpr
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum
            [ 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
    div)
            , RuleM CoreExpr
    leftZero
            , do
              [arg, Lit (LitNumber LitNumInt d)] <- RuleM [CoreExpr]
    getArgs
              Just n <- return $ exactLog2 d
              platform <- getPlatform
              return $ Var (primOpId IntSraOp) `App` arg `App` mkIntVal platform n
            ],

         Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkBasicRule Name
    modIntName ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ [RuleM CoreExpr] -> RuleM CoreExpr
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum
            [ 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
    mod)
            , RuleM CoreExpr
    leftZero
            , do
              [arg, Lit (LitNumber LitNumInt d)] <- RuleM [CoreExpr]
    getArgs
              Just _ <- return $ exactLog2 d
              platform <- getPlatform
              return $ Var (primOpId IntAndOp)
                `App` arg `App` mkIntVal platform (d - 1)
            ]
         ]
     [CoreRule] -> [CoreRule] -> [CoreRule]
    forall a. [a] -> [a] -> [a]
    ++ [CoreRule]
    builtinBignumRules
    {-# NOINLINE builtinRules #-}
    -- there is no benefit to inlining these yet, despite this, GHC produces
    -- unfoldings for this regardless since the floated list entries look small.

    builtinBignumRules :: [CoreRule]
    builtinBignumRules :: [CoreRule]
    builtinBignumRules =
      [ -- conversions
        String -> Name -> CoreRule
    lit_to_integer String
    "Word# -> Integer"   Name
    integerFromWordName
      , String -> Name -> CoreRule
    lit_to_integer String
    "Int64# -> Integer"  Name
    integerFromInt64Name
      , String -> Name -> CoreRule
    lit_to_integer String
    "Word64# -> Integer" Name
    integerFromWord64Name
      , String -> Name -> CoreRule
    lit_to_integer String
    "Natural -> Integer" Name
    integerFromNaturalName

      , String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
    integer_to_lit String
    "Integer -> Word# (wrap)"   Name
    integerToWordName   Platform -> Integer -> CoreExpr
    forall b. Platform -> Integer -> Expr b
    mkWordLitWrap
      , String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
    integer_to_lit String
    "Integer -> Int# (wrap)"    Name
    integerToIntName    Platform -> Integer -> CoreExpr
    forall b. Platform -> Integer -> Expr b
    mkIntLitWrap
      , String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
    integer_to_lit String
    "Integer -> Word64# (wrap)" Name
    integerToWord64Name (\Platform
    _ -> Word64 -> CoreExpr
    forall b. Word64 -> Expr b
    mkWord64LitWord64 (Word64 -> CoreExpr) -> (Integer -> Word64) -> Integer -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Word64
    forall a. Num a => Integer -> a
    fromInteger)
      , String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
    integer_to_lit String
    "Integer -> Int64# (wrap)"  Name
    integerToInt64Name  (\Platform
    _ -> Int64 -> CoreExpr
    forall b. Int64 -> Expr b
    mkInt64LitInt64 (Int64 -> CoreExpr) -> (Integer -> Int64) -> Integer -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Int64
    forall a. Num a => Integer -> a
    fromInteger)
      , String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
    integer_to_lit String
    "Integer -> Float#"         Name
    integerToFloatName  (\Platform
    _ -> Float -> CoreExpr
    forall b. Float -> Expr b
    mkFloatLitFloat (Float -> CoreExpr) -> (Integer -> Float) -> Integer -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Float
    forall a. Num a => Integer -> a
    fromInteger)
      , String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
    integer_to_lit String
    "Integer -> Double#"        Name
    integerToDoubleName (\Platform
    _ -> Double -> CoreExpr
    forall b. Double -> Expr b
    mkDoubleLitDouble (Double -> CoreExpr) -> (Integer -> Double) -> Integer -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger)

      , String -> Name -> Bool -> Bool -> CoreRule
    integer_to_natural String
    "Integer -> Natural (clamp)" Name
    integerToNaturalClampName Bool
    False Bool
    True
      , String -> Name -> Bool -> Bool -> CoreRule
    integer_to_natural String
    "Integer -> Natural (wrap)"  Name
    integerToNaturalName      Bool
    False Bool
    False
      , String -> Name -> Bool -> Bool -> CoreRule
    integer_to_natural String
    "Integer -> Natural (throw)" Name
    integerToNaturalThrowName Bool
    True Bool
    False

      , String -> Name -> CoreRule
    natural_to_word String
    "Natural -> Word# (wrap)"  Name
    naturalToWordName

        -- comparisons (return an unlifted Int#)
      , String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
    bignum_bin_pred String
    "bigNatEq#"  Name
    bignatEqName Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)

        -- comparisons (return an Ordering)
      , String -> Name -> CoreRule
    bignum_compare String
    "bignatCompare"      Name
    bignatCompareName
      , String -> Name -> CoreRule
    bignum_compare String
    "bignatCompareWord#" Name
    bignatCompareWordName

        -- binary operations
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    integer_binop String
    "integerAdd" Name
    integerAddName Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    (+)
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    integer_binop String
    "integerSub" Name
    integerSubName (-)
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    integer_binop String
    "integerMul" Name
    integerMulName Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    (*)
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    integer_binop String
    "integerGcd" Name
    integerGcdName Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    gcd
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    integer_binop String
    "integerLcm" Name
    integerLcmName Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    lcm
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    integer_binop String
    "integerAnd" Name
    integerAndName Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    (.&.)
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    integer_binop String
    "integerOr"  Name
    integerOrName  Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    (.|.)
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    integer_binop String
    "integerXor" Name
    integerXorName Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    xor

      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    natural_binop String
    "naturalAdd" Name
    naturalAddName Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    (+)
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    natural_binop String
    "naturalMul" Name
    naturalMulName Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    (*)
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    natural_binop String
    "naturalGcd" Name
    naturalGcdName Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    gcd
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    natural_binop String
    "naturalLcm" Name
    naturalLcmName Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    lcm
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    natural_binop String
    "naturalAnd" Name
    naturalAndName Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    (.&.)
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    natural_binop String
    "naturalOr"  Name
    naturalOrName  Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    (.|.)
      , String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    natural_binop String
    "naturalXor" Name
    naturalXorName Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    xor

        -- Natural subtraction: it's a binop but it can fail because of underflow so
        -- we have several primitives to handle here.
      , String -> Name -> CoreRule
    natural_sub String
    "naturalSubUnsafe" Name
    naturalSubUnsafeName
      , String -> Name -> CoreRule
    natural_sub String
    "naturalSubThrow"  Name
    naturalSubThrowName
      , String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    "naturalSub" Name
    naturalSubName ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
            [a0,a1] <- RuleM [CoreExpr]
    getArgs
            x <- isNaturalLiteral a0
            y <- isNaturalLiteral a1
            -- return an unboxed sum: (# (# #) | Natural #)
            let ret ConTagZ
    n CoreExpr
    v = CoreExpr -> f CoreExpr
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CoreExpr -> f CoreExpr) -> CoreExpr -> f CoreExpr
    forall a b. (a -> b) -> a -> b
    $ ConTagZ -> ConTagZ -> [Type] -> CoreExpr -> CoreExpr
    mkCoreUnboxedSum ConTagZ
    2 ConTagZ
    n [Type
    unboxedUnitTy,Type
    naturalTy] CoreExpr
    v
            platform <- getPlatform
            if x < y
                then ret 1 unboxedUnitExpr
                else ret 2 $ mkNaturalExpr platform (x - y)

        -- unary operations
      , String
    -> Name
    -> (Platform -> Integer -> CoreExpr)
    -> (Integer -> Integer)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Platform -> t -> CoreExpr)
    -> (Integer -> t)
    -> CoreRule
    bignum_unop String
    "integerNegate"     Name
    integerNegateName     Platform -> Integer -> CoreExpr
    mkIntegerExpr Integer -> Integer
    forall a. Num a => a -> a
    negate
      , String
    -> Name
    -> (Platform -> Integer -> CoreExpr)
    -> (Integer -> Integer)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Platform -> t -> CoreExpr)
    -> (Integer -> t)
    -> CoreRule
    bignum_unop String
    "integerAbs"        Name
    integerAbsName        Platform -> Integer -> CoreExpr
    mkIntegerExpr Integer -> Integer
    forall a. Num a => a -> a
    abs
      , String
    -> Name
    -> (Platform -> Integer -> CoreExpr)
    -> (Integer -> Integer)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Platform -> t -> CoreExpr)
    -> (Integer -> t)
    -> CoreRule
    bignum_unop String
    "integerComplement" Name
    integerComplementName Platform -> Integer -> CoreExpr
    mkIntegerExpr Integer -> Integer
    forall a. Bits a => a -> a
    complement

      , String -> Name -> (Platform -> Integer -> Literal) -> CoreRule
    forall {t}.
    Num t =>
    String -> Name -> (Platform -> t -> Literal) -> CoreRule
    bignum_popcount String
    "integerPopCount" Name
    integerPopCountName Platform -> Integer -> Literal
    mkLitIntWrap
      , String -> Name -> (Platform -> Integer -> Literal) -> CoreRule
    forall {t}.
    Num t =>
    String -> Name -> (Platform -> t -> Literal) -> CoreRule
    bignum_popcount String
    "naturalPopCount" Name
    naturalPopCountName Platform -> Integer -> Literal
    mkLitWordWrap

        -- Bits.bit
      , String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
    forall {t}.
    Bits t =>
    String -> Name -> (Platform -> t -> CoreExpr) -> CoreRule
    bignum_bit String
    "integerBit" Name
    integerBitName Platform -> Integer -> CoreExpr
    mkIntegerExpr
      , String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
    forall {t}.
    Bits t =>
    String -> Name -> (Platform -> t -> CoreExpr) -> CoreRule
    bignum_bit String
    "naturalBit" Name
    naturalBitName Platform -> Integer -> CoreExpr
    mkNaturalExpr

        -- Bits.testBit
      , String -> Name -> CoreRule
    bignum_testbit String
    "integerTestBit" Name
    integerTestBitName
      , String -> Name -> CoreRule
    bignum_testbit String
    "naturalTestBit" Name
    naturalTestBitName

        -- Bits.shift
      , String
    -> Name
    -> (Integer -> ConTagZ -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t} {t}.
    Num t =>
    String
    -> Name
    -> (Integer -> t -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    bignum_shift String
    "integerShiftL" Name
    integerShiftLName Integer -> ConTagZ -> Integer
    forall a. Bits a => a -> ConTagZ -> a
    shiftL Platform -> Integer -> CoreExpr
    mkIntegerExpr
      , String
    -> Name
    -> (Integer -> ConTagZ -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t} {t}.
    Num t =>
    String
    -> Name
    -> (Integer -> t -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    bignum_shift String
    "integerShiftR" Name
    integerShiftRName Integer -> ConTagZ -> Integer
    forall a. Bits a => a -> ConTagZ -> a
    shiftR Platform -> Integer -> CoreExpr
    mkIntegerExpr
      , String
    -> Name
    -> (Integer -> ConTagZ -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t} {t}.
    Num t =>
    String
    -> Name
    -> (Integer -> t -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    bignum_shift String
    "naturalShiftL" Name
    naturalShiftLName Integer -> ConTagZ -> Integer
    forall a. Bits a => a -> ConTagZ -> a
    shiftL Platform -> Integer -> CoreExpr
    mkNaturalExpr
      , String
    -> Name
    -> (Integer -> ConTagZ -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t} {t}.
    Num t =>
    String
    -> Name
    -> (Integer -> t -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    bignum_shift String
    "naturalShiftR" Name
    naturalShiftRName Integer -> ConTagZ -> Integer
    forall a. Bits a => a -> ConTagZ -> a
    shiftR Platform -> Integer -> CoreExpr
    mkNaturalExpr

        -- division
      , String
    -> Name
    -> (Integer -> Integer -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Integer -> Integer -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_one  String
    "integerQuot"    Name
    integerQuotName    Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    quot    Platform -> Integer -> CoreExpr
    mkIntegerExpr
      , String
    -> Name
    -> (Integer -> Integer -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Integer -> Integer -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_one  String
    "integerRem"     Name
    integerRemName     Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    rem     Platform -> Integer -> CoreExpr
    mkIntegerExpr
      , String
    -> Name
    -> (Integer -> Integer -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Integer -> Integer -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_one  String
    "integerDiv"     Name
    integerDivName     Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    div     Platform -> Integer -> CoreExpr
    mkIntegerExpr
      , String
    -> Name
    -> (Integer -> Integer -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Integer -> Integer -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_one  String
    "integerMod"     Name
    integerModName     Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    mod     Platform -> Integer -> CoreExpr
    mkIntegerExpr
      , String
    -> Name
    -> (Integer -> Integer -> (Integer, Integer))
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Integer -> Integer -> (t, t))
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_both String
    "integerDivMod"  Name
    integerDivModName  Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    divMod  Platform -> Integer -> CoreExpr
    mkIntegerExpr
      , String
    -> Name
    -> (Integer -> Integer -> (Integer, Integer))
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Integer -> Integer -> (t, t))
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_both String
    "integerQuotRem" Name
    integerQuotRemName Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    quotRem Platform -> Integer -> CoreExpr
    mkIntegerExpr

      , String
    -> Name
    -> (Integer -> Integer -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Integer -> Integer -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_one  String
    "naturalQuot"    Name
    naturalQuotName    Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    quot    Platform -> Integer -> CoreExpr
    mkNaturalExpr
      , String
    -> Name
    -> (Integer -> Integer -> Integer)
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Integer -> Integer -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_one  String
    "naturalRem"     Name
    naturalRemName     Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    rem     Platform -> Integer -> CoreExpr
    mkNaturalExpr
      , String
    -> Name
    -> (Integer -> Integer -> (Integer, Integer))
    -> (Platform -> Integer -> CoreExpr)
    -> CoreRule
    forall {t}.
    String
    -> Name
    -> (Integer -> Integer -> (t, t))
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_both String
    "naturalQuotRem" Name
    naturalQuotRemName Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    quotRem Platform -> Integer -> CoreExpr
    mkNaturalExpr

        -- conversions from Rational for Float/Double literals
      , String -> Name -> (Float -> CoreExpr) -> CoreRule
    forall a.
    RealFloat a =>
    String -> Name -> (a -> CoreExpr) -> CoreRule
    rational_to String
    "rationalToFloat"  Name
    rationalToFloatName  Float -> CoreExpr
    mkFloatExpr
      , String -> Name -> (Double -> CoreExpr) -> CoreRule
    forall a.
    RealFloat a =>
    String -> Name -> (a -> CoreExpr) -> CoreRule
    rational_to String
    "rationalToDouble" Name
    rationalToDoubleName Double -> CoreExpr
    mkDoubleExpr

        -- conversions from Integer for Float/Double literals
      , String -> Name -> (Float -> CoreExpr) -> CoreRule
    forall a.
    RealFloat a =>
    String -> Name -> (a -> CoreExpr) -> CoreRule
    integer_encode_float String
    "integerEncodeFloat"  Name
    integerEncodeFloatName  Float -> CoreExpr
    forall b. Float -> Expr b
    mkFloatLitFloat
      , String -> Name -> (Double -> CoreExpr) -> CoreRule
    forall a.
    RealFloat a =>
    String -> Name -> (a -> CoreExpr) -> CoreRule
    integer_encode_float String
    "integerEncodeDouble" Name
    integerEncodeDoubleName Double -> CoreExpr
    forall b. Double -> Expr b
    mkDoubleLitDouble
      ]
      where
        mkRule :: String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    nargs RuleM CoreExpr
    f = BuiltinRule
          { ru_name :: RuleName
    ru_name = String -> RuleName
    fsLit String
    str
          , ru_fn :: Name
    ru_fn = Name
    name
          , ru_nargs :: ConTagZ
    ru_nargs = ConTagZ
    nargs
          , ru_try :: RuleFun
    ru_try = RuleM CoreExpr -> RuleFun
    forall r.
    RuleM r -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r
    runRuleM (RuleM CoreExpr -> RuleFun) -> RuleM CoreExpr -> RuleFun
    forall a b. (a -> b) -> a -> b
    $ do
              env <- RuleM RuleOpts
    getRuleOpts
              guard (roBignumRules env)
              f
          }

        integer_to_lit :: String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
    integer_to_lit String
    str Name
    name Platform -> Integer -> CoreExpr
    convert = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0] <- RuleM [CoreExpr]
    getArgs
          platform <- getPlatform
          -- we only match on Big Integer literals. Small literals
          -- are matched by the "Int# -> Integer -> *" rules
          x <- isBigIntegerLiteral a0
          pure (convert platform x)

        natural_to_word :: String -> Name -> CoreRule
    natural_to_word String
    str Name
    name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0] <- RuleM [CoreExpr]
    getArgs
          n <- isNaturalLiteral a0
          platform <- getPlatform
          pure (Lit (mkLitWordWrap platform n))

        integer_to_natural :: String -> Name -> Bool -> Bool -> CoreRule
    integer_to_natural String
    str Name
    name Bool
    thrw Bool
    clamp = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0] <- RuleM [CoreExpr]
    getArgs
          x <- isIntegerLiteral a0
          platform <- getPlatform
          if | x >= 0    -> pure $ mkNaturalExpr platform x
             | thrw      -> mzero
             | clamp     -> pure $ mkNaturalExpr platform 0       -- clamp to 0
             | otherwise -> pure $ mkNaturalExpr platform (abs x) -- negate/wrap

        lit_to_integer :: String -> Name -> CoreRule
    lit_to_integer String
    str Name
    name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0] <- RuleM [CoreExpr]
    getArgs
          platform <- getPlatform
          i <- isBignumLiteral a0
          -- convert any numeric literal into an Integer literal
          pure (mkIntegerExpr platform i)

        integer_binop :: String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    integer_binop String
    str Name
    name Integer -> Integer -> Integer
    op = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          x <- isIntegerLiteral a0
          y <- isIntegerLiteral a1
          platform <- getPlatform
          pure (mkIntegerExpr platform (x `op` y))

        natural_binop :: String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
    natural_binop String
    str Name
    name Integer -> Integer -> Integer
    op = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          x <- isNaturalLiteral a0
          y <- isNaturalLiteral a1
          platform <- getPlatform
          pure (mkNaturalExpr platform (x `op` y))

        natural_sub :: String -> Name -> CoreRule
    natural_sub String
    str Name
    name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          x <- isNaturalLiteral a0
          y <- isNaturalLiteral a1
          guard (x >= y)
          platform <- getPlatform
          pure (mkNaturalExpr platform (x - y))

        bignum_bin_pred :: String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
    bignum_bin_pred String
    str Name
    name Integer -> Integer -> Bool
    op = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          platform <- RuleM Platform
    getPlatform
          [a0,a1] <- getArgs
          x <- isBignumLiteral a0
          y <- isBignumLiteral a1
          pure $ if x `op` y
                  then trueValInt platform
                  else falseValInt platform

        bignum_compare :: String -> Name -> CoreRule
    bignum_compare String
    str Name
    name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          x <- isBignumLiteral a0
          y <- isBignumLiteral a1
          pure $ case x `compare` y of
                  Ordering
    LT -> CoreExpr
    ltVal
                  Ordering
    EQ -> CoreExpr
    eqVal
                  Ordering
    GT -> CoreExpr
    gtVal

        bignum_unop :: String
    -> Name
    -> (Platform -> t -> CoreExpr)
    -> (Integer -> t)
    -> CoreRule
    bignum_unop String
    str Name
    name Platform -> t -> CoreExpr
    mk_lit Integer -> t
    op = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0] <- RuleM [CoreExpr]
    getArgs
          x <- isBignumLiteral a0
          platform <- getPlatform
          pure $ mk_lit platform (op x)

        bignum_popcount :: String -> Name -> (Platform -> t -> Literal) -> CoreRule
    bignum_popcount String
    str Name
    name Platform -> t -> Literal
    mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          platform <- RuleM Platform
    getPlatform
          -- We use a host Int to compute the popCount. If we compile on a 32-bit
          -- host for a 64-bit target, the result may be different than if computed
          -- by the target. So we disable this rule if sizes don't match.
          guard (platformWordSizeInBits platform <= finiteBitSize (0 :: Word))
          [a0] <- getArgs
          x <- isBignumLiteral a0
          pure $ Lit (mk_lit platform (fromIntegral (popCount x)))

        bignum_bit :: String -> Name -> (Platform -> t -> CoreExpr) -> CoreRule
    bignum_bit String
    str Name
    name Platform -> t -> CoreExpr
    mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0] <- RuleM [CoreExpr]
    getArgs
          platform <- getPlatform
          n <- isNumberLiteral a0
          -- Make sure n is positive and small enough to yield a decently
          -- small number. Attempting to construct the Integer for
          --    (integerBit 9223372036854775807#)
          -- would be a bad idea (#14959)
          guard (n >= 0 && n <= fromIntegral (platformWordSizeInBits platform))
          -- it's safe to convert a target Int value into a host Int value
          -- to perform the "bit" operation because n is very small (<= 64).
          pure $ mk_lit platform (bit (fromIntegral n))

        bignum_testbit :: String -> Name -> CoreRule
    bignum_testbit String
    str Name
    name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          platform <- getPlatform
          x <- isBignumLiteral a0
          n <- isNumberLiteral a1
          -- ensure that we can store 'n' in a host Int
          guard (n >= 0 && n <= fromIntegral (maxBound :: Int))
          pure $ if testBit x (fromIntegral n)
                  then trueValInt platform
                  else falseValInt platform

        bignum_shift :: String
    -> Name
    -> (Integer -> t -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    bignum_shift String
    str Name
    name Integer -> t -> t
    shift_op Platform -> t -> CoreExpr
    mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          x <- isBignumLiteral a0
          n <- isNumberLiteral a1
          -- See Note [Guarding against silly shifts]
          -- Restrict constant-folding of shifts on Integers, somewhat arbitrary.
          -- We can get huge shifts in inaccessible code (#15673)
          guard (n <= 4)
          platform <- getPlatform
          pure $ mk_lit platform (x `shift_op` fromIntegral n)

        divop_one :: String
    -> Name
    -> (Integer -> Integer -> t)
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_one String
    str Name
    name Integer -> Integer -> t
    divop Platform -> t -> CoreExpr
    mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          n <- isBignumLiteral a0
          d <- isBignumLiteral a1
          guard (d /= 0)
          platform <- getPlatform
          pure $ mk_lit platform (n `divop` d)

        divop_both :: String
    -> Name
    -> (Integer -> Integer -> (t, t))
    -> (Platform -> t -> CoreExpr)
    -> CoreRule
    divop_both String
    str Name
    name Integer -> Integer -> (t, t)
    divop Platform -> t -> CoreExpr
    mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          n <- isBignumLiteral a0
          d <- isBignumLiteral a1
          guard (d /= 0)
          let (r,s) = n `divop` d
          platform <- getPlatform
          pure $ mkCoreUnboxedTuple [mk_lit platform r, mk_lit platform s]

        integer_encode_float :: RealFloat a => String -> Name -> (a -> CoreExpr) -> CoreRule
        integer_encode_float :: forall a.
    RealFloat a =>
    String -> Name -> (a -> CoreExpr) -> CoreRule
    integer_encode_float String
    str Name
    name a -> CoreExpr
    mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          x <- isIntegerLiteral a0
          y <- isNumberLiteral a1
          -- check that y (a target Int) is in the host Int range
          guard (y <= fromIntegral (maxBound :: Int))
          pure (mk_lit $ encodeFloat x (fromInteger y))

        rational_to :: RealFloat a => String -> Name -> (a -> CoreExpr) -> CoreRule
        rational_to :: forall a.
    RealFloat a =>
    String -> Name -> (a -> CoreExpr) -> CoreRule
    rational_to String
    str Name
    name a -> CoreExpr
    mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
    mkRule String
    str Name
    name ConTagZ
    2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
    forall a b. (a -> b) -> a -> b
    $ do
          -- This turns `rationalToFloat n d` where `n` and `d` are literals into
          -- a literal Float (and similarly for Double).
          [a0,a1] <- RuleM [CoreExpr]
    getArgs
          n <- isIntegerLiteral a0
          d <- isIntegerLiteral a1
          -- it's important to not match d == 0, because that may represent a
          -- literal "0/0" or similar, and we can't produce a literal value for
          -- NaN or +-Inf
          guard (d /= 0)
          pure $ mk_lit (fromRational (n % d))

    ---------------------------------------------------
    -- The rules are:
    --      unpackAppendCString*# "foo"# (unpackCString*# "baz"#)
    --      =  unpackCString*# "foobaz"#
    --
    --      unpackAppendCString*# "foo"# (unpackAppendCString*# "baz"# e)
    --      =  unpackAppendCString*# "foobaz"# e
    --

    -- CString version
    match_cstring_append_lit_C :: RuleFun
    match_cstring_append_lit_C :: RuleFun
    match_cstring_append_lit_C = Unique -> Unique -> RuleFun
    match_cstring_append_lit Unique
    unpackCStringAppendIdKey Unique
    unpackCStringIdKey

    -- CStringUTF8 version
    match_cstring_append_lit_utf8 :: RuleFun
    match_cstring_append_lit_utf8 :: RuleFun
    match_cstring_append_lit_utf8 = Unique -> Unique -> RuleFun
    match_cstring_append_lit Unique
    unpackCStringAppendUtf8IdKey Unique
    unpackCStringUtf8IdKey

    {-# INLINE match_cstring_append_lit #-}
    match_cstring_append_lit :: Unique -> Unique -> RuleFun
    match_cstring_append_lit :: Unique -> Unique -> RuleFun
    match_cstring_append_lit Unique
    append_key Unique
    unpack_key RuleOpts
    _ InScopeEnv
    env Id
    _ [CoreExpr
    lit1, CoreExpr
    e2]
      | Just (LitString ByteString
    s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    lit1
      , ([CoreTickish]
    strTicks, Var Id
    unpk `App` CoreExpr
    lit2) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
    stripStrTopTicks InScopeEnv
    env CoreExpr
    e2
      , Id
    unpk Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    unpack_key
      , Just (LitString ByteString
    s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    lit2
      = CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [CoreTickish] -> CoreExpr -> CoreExpr
    mkTicks [CoreTickish]
    strTicks
             (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    unpk CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (ByteString -> Literal
    LitString (ByteString
    s1 ByteString -> ByteString -> ByteString
    `BS.append` ByteString
    s2))

      | Just (LitString ByteString
    s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    lit1
      , ([CoreTickish]
    strTicks, Var Id
    appnd `App` CoreExpr
    lit2 `App` CoreExpr
    e) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
    stripStrTopTicks InScopeEnv
    env CoreExpr
    e2
      , Id
    appnd Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    append_key
      , Just (LitString ByteString
    s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    lit2
      = CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [CoreTickish] -> CoreExpr -> CoreExpr
    mkTicks [CoreTickish]
    strTicks
             (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    appnd CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (ByteString -> Literal
    LitString (ByteString
    s1 ByteString -> ByteString -> ByteString
    `BS.append` ByteString
    s2)) CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    e

    match_cstring_append_lit Unique
    _ Unique
    _ RuleOpts
    _ InScopeEnv
    _ Id
    _ [CoreExpr]
    _ = Maybe CoreExpr
    forall a. Maybe a
    Nothing

    ---------------------------------------------------
    -- The rule is this:
    --      unpackFoldrCString*# "foo"# c (unpackFoldrCString*# "baz"# c n)
    --      =  unpackFoldrCString*# "foobaz"# c n
    --
    -- See also Note [String literals in GHC] in CString.hs

    -- CString version
    match_cstring_foldr_lit_C :: RuleFun
    match_cstring_foldr_lit_C :: RuleFun
    match_cstring_foldr_lit_C = Unique -> RuleFun
    match_cstring_foldr_lit Unique
    unpackCStringFoldrIdKey

    -- CStringUTF8 version
    match_cstring_foldr_lit_utf8 :: RuleFun
    match_cstring_foldr_lit_utf8 :: RuleFun
    match_cstring_foldr_lit_utf8 = Unique -> RuleFun
    match_cstring_foldr_lit Unique
    unpackCStringFoldrUtf8IdKey

    {-# INLINE match_cstring_foldr_lit #-}
    match_cstring_foldr_lit :: Unique -> RuleFun
    match_cstring_foldr_lit :: Unique -> RuleFun
    match_cstring_foldr_lit Unique
    foldVariant RuleOpts
    _ InScopeEnv
    env Id
    _
            [ Type Type
    ty1
            , CoreExpr
    lit1
            , CoreExpr
    c1
            , CoreExpr
    e2
            ]
      | ([CoreTickish]
    strTicks, Var Id
    unpk `App` Type Type
    ty2
                            `App` CoreExpr
    lit2
                            `App` CoreExpr
    c2
                            `App` CoreExpr
    n) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
    stripStrTopTicks InScopeEnv
    env CoreExpr
    e2
      , Id
    unpk Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    foldVariant
      , Just (LitString ByteString
    s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    lit1
      , Just (LitString ByteString
    s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    lit2
      , CoreExpr -> CoreExpr -> Bool
    eqCoreExpr CoreExpr
    c1 CoreExpr
    c2
      , ([CoreTickish]
    c1Ticks, CoreExpr
    c1') <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
    stripStrTopTicks InScopeEnv
    env CoreExpr
    c1
      , [CoreTickish]
    c2Ticks <- CoreExpr -> [CoreTickish]
    stripStrTopTicksT CoreExpr
    c2
      = Bool -> Maybe CoreExpr -> Maybe CoreExpr
    forall a. HasCallStack => Bool -> a -> a
    assert (Type
    ty1 Type -> Type -> Bool
    `eqType` Type
    ty2) (Maybe CoreExpr -> Maybe CoreExpr)
    -> Maybe CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [CoreTickish] -> CoreExpr -> CoreExpr
    mkTicks [CoreTickish]
    strTicks
             (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    unpk CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    ty1
                        CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (ByteString -> Literal
    LitString (ByteString
    s1 ByteString -> ByteString -> ByteString
    `BS.append` ByteString
    s2))
                        CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` [CoreTickish] -> CoreExpr -> CoreExpr
    mkTicks ([CoreTickish]
    c1Ticks [CoreTickish] -> [CoreTickish] -> [CoreTickish]
    forall a. [a] -> [a] -> [a]
    ++ [CoreTickish]
    c2Ticks) CoreExpr
    c1'
                        CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    n

    match_cstring_foldr_lit Unique
    _ RuleOpts
    _ InScopeEnv
    _ Id
    _ [CoreExpr]
    _ = Maybe CoreExpr
    forall a. Maybe a
    Nothing

    -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the
    -- argument, lest this may fail to fire when building with -g3. See #16740.
    --
    -- Also, look into variable's unfolding just in case the expression we look for
    -- is in a top-level thunk.
    stripStrTopTicks :: InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
    stripStrTopTicks :: InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
    stripStrTopTicks (ISE InScopeSet
    _ IdUnfoldingFun
    id_unf) CoreExpr
    e = case CoreExpr
    e of
      Var Id
    v
        | Just CoreExpr
    rhs <- Unfolding -> Maybe CoreExpr
    expandUnfolding_maybe (IdUnfoldingFun
    id_unf Id
    v)
        -> (CoreTickish -> Bool) -> CoreExpr -> ([CoreTickish], CoreExpr)
    forall b.
    (CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b)
    stripTicksTop CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreExpr
    rhs
      CoreExpr
    _ -> (CoreTickish -> Bool) -> CoreExpr -> ([CoreTickish], CoreExpr)
    forall b.
    (CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b)
    stripTicksTop CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreExpr
    e

    stripStrTopTicksT :: CoreExpr -> [CoreTickish]
    stripStrTopTicksT :: CoreExpr -> [CoreTickish]
    stripStrTopTicksT CoreExpr
    e = (CoreTickish -> Bool) -> CoreExpr -> [CoreTickish]
    forall b. (CoreTickish -> Bool) -> Expr b -> [CoreTickish]
    stripTicksTopT CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreExpr
    e

    ---------------------------------------------------
    -- The rule is this:
    --      eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2
    -- Also  matches unpackCStringUtf8#

    match_eq_string :: RuleFun
    match_eq_string :: RuleFun
    match_eq_string RuleOpts
    _ InScopeEnv
    env Id
    _ [CoreExpr
    e1, CoreExpr
    e2]
      | ([CoreTickish]
    ticks1, Var Id
    unpk1 `App` CoreExpr
    lit1) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
    stripStrTopTicks InScopeEnv
    env CoreExpr
    e1
      , ([CoreTickish]
    ticks2, Var Id
    unpk2 `App` CoreExpr
    lit2) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
    stripStrTopTicks InScopeEnv
    env CoreExpr
    e2
      , Unique
    unpk_key1 <- Id -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique Id
    unpk1
      , Unique
    unpk_key2 <- Id -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique Id
    unpk2
      , Unique
    unpk_key1 Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    unpk_key2
      -- For now we insist the literals have to agree in their encoding
      -- to keep the rule simple. But we could check if the decoded strings
      -- compare equal in here as well.
      , Unique
    unpk_key1 Unique -> [Unique] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Unique
    unpackCStringUtf8IdKey, Unique
    unpackCStringIdKey]
      , Just (LitString ByteString
    s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    lit1
      , Just (LitString ByteString
    s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    lit2
      = CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [CoreTickish] -> CoreExpr -> CoreExpr
    mkTicks ([CoreTickish]
    ticks1 [CoreTickish] -> [CoreTickish] -> [CoreTickish]
    forall a. [a] -> [a] -> [a]
    ++ [CoreTickish]
    ticks2)
             (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ (if ByteString
    s1 ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    s2 then CoreExpr
    trueValBool else CoreExpr
    falseValBool)

    match_eq_string RuleOpts
    _ InScopeEnv
    _ Id
    _ [CoreExpr]
    _ = Maybe CoreExpr
    forall a. Maybe a
    Nothing

    -----------------------------------------------------------------------
    -- Illustration of this rule:
    --
    -- cstringLength# "foobar"# --> 6
    -- cstringLength# "fizz\NULzz"# --> 4
    --
    -- Nota bene: Addr# literals are suffixed by a NUL byte when they are
    -- compiled to read-only data sections. That's why cstringLength# is
    -- well defined on Addr# literals that do not explicitly have an embedded
    -- NUL byte.
    --
    -- See GHC issue #5218, MR 2165, and bytestring PR 191. This is particularly
    -- helpful when using OverloadedStrings to create a ByteString since the
    -- function computing the length of such ByteStrings can often be constant
    -- folded.
    match_cstring_length :: RuleFun
    match_cstring_length :: RuleFun
    match_cstring_length RuleOpts
    rule_env InScopeEnv
    env Id
    _ [CoreExpr
    lit1]
      | Just (LitString ByteString
    str) <- InScopeEnv -> CoreExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env CoreExpr
    lit1
        -- If elemIndex returns Just, it has the index of the first embedded NUL
        -- in the string. If no NUL bytes are present (the common case) then use
        -- full length of the byte string.
      = let len :: ConTagZ
    len = ConTagZ -> Maybe ConTagZ -> ConTagZ
    forall a. a -> Maybe a -> a
    fromMaybe (ByteString -> ConTagZ
    BS.length ByteString
    str) (Word8 -> ByteString -> Maybe ConTagZ
    BS.elemIndex Word8
    0 ByteString
    str)
         in CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Platform -> Integer -> Literal
    mkLitInt (RuleOpts -> Platform
    roPlatform RuleOpts
    rule_env) (ConTagZ -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ConTagZ
    len)))
    match_cstring_length RuleOpts
    _ InScopeEnv
    _ Id
    _ [CoreExpr]
    _ = Maybe CoreExpr
    forall a. Maybe a
    Nothing

    {- Note [inlineId magic]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    The call 'inline f' arranges that 'f' is inlined, regardless of
    its size. More precisely, the call 'inline f' rewrites to the
    right-hand side of 'f's definition. This allows the programmer to
    control inlining from a particular call site rather than the
    definition site of the function.

    The moving parts are simple:

    * A very simple definition in the library base:GHC.Magic
         {-# NOINLINE[0] inline #-}
         inline :: a -> a
         inline x = x
      So in phase 0, 'inline' will be inlined, so its use imposes
      no overhead.

    * A rewrite rule, in GHC.Core.Opt.ConstantFold, which makes
      (inline f) inline, implemented by match_inline.
      The rule for the 'inline' function is this:
         inline f_ty (f a b c) = <f's unfolding> a b c
      (if f has an unfolding, EVEN if it's a loop breaker)

      It's important to allow the argument to 'inline' to have args itself
      (a) because its more forgiving to allow the programmer to write
          either  inline f a b c
          or      inline (f a b c)
      (b) because a polymorphic f wll get a type argument that the
          programmer can't avoid, so the call may look like
            inline (map @Int @Bool) g xs

      Also, don't forget about 'inline's type argument!
    -}

    match_inline :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)
    match_inline :: [CoreExpr] -> Maybe CoreExpr
    match_inline (Type Type
    _ : CoreExpr
    e : [CoreExpr]
    _)
      | (Var Id
    f, [CoreExpr]
    args1) <- CoreExpr -> (CoreExpr, [CoreExpr])
    forall b. Expr b -> (Expr b, [Expr b])
    collectArgs CoreExpr
    e,
        Just CoreExpr
    unf <- Unfolding -> Maybe CoreExpr
    maybeUnfoldingTemplate (IdUnfoldingFun
    realIdUnfolding Id
    f)
                 -- Ignore the IdUnfoldingFun here!
      = CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps CoreExpr
    unf [CoreExpr]
    args1)

    match_inline [CoreExpr]
    _ = Maybe CoreExpr
    forall a. Maybe a
    Nothing

    --------------------------------------------------------
    -- Note [Constant folding through nested expressions]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- We use rewrites rules to perform constant folding. It means that we don't
    -- have a global view of the expression we are trying to optimise. As a
    -- consequence we only perform local (small-step) transformations that either:
    --    1) reduce the number of operations
    --    2) rearrange the expression to increase the odds that other rules will
    --    match
    --
    -- We don't try to handle more complex expression optimisation cases that would
    -- require a global view. For example, rewriting expressions to increase
    -- sharing (e.g., Horner's method); optimisations that require local
    -- transformations increasing the number of operations; rearrangements to
    -- cancel/factorize terms (e.g., (a+b-a-b) isn't rearranged to reduce to 0).
    --
    -- We already have rules to perform constant folding on expressions with the
    -- following shape (where a and/or b are literals):
    --
    --          D)    op
    --                /\
    --               /  \
    --              /    \
    --             a      b
    --
    -- To support nested expressions, we match three other shapes of expression
    -- trees:
    --
    -- A)   op1          B)       op1       C)       op1
    --      /\                    /\                 /\
    --     /  \                  /  \               /  \
    --    /    \                /    \             /    \
    --   a     op2            op2     c          op2    op3
    --          /\            /\                 /\      /\
    --         /  \          /  \               /  \    /  \
    --        b    c        a    b             a    b  c    d
    --
    --
    -- R1) +/- simplification:
    --    ops = + or -, two literals (not siblings)
    --
    --    Examples:
    --       A: 5 + (10-x)  ==> 15-x
    --       B: (10+x) + 5  ==> 15+x
    --       C: (5+a)-(5-b) ==> 0+(a+b)
    --
    -- R2) *, `and`, `or`  simplification
    --    ops = *, `and`, `or` two literals (not siblings)
    --
    --    Examples:
    --       A: 5 * (10*x)  ==> 50*x
    --       B: (10*x) * 5  ==> 50*x
    --       C: (5*a)*(5*b) ==> 25*(a*b)
    --
    -- R3) * distribution over +/-
    --    op1 = *, op2 = + or -, two literals (not siblings)
    --
    --    This transformation doesn't reduce the number of operations but switches
    --    the outer and the inner operations so that the outer is (+) or (-) instead
    --    of (*). It increases the odds that other rules will match after this one.
    --
    --    Examples:
    --       A: 5 * (10-x)  ==> 50 - (5*x)
    --       B: (10+x) * 5  ==> 50 + (5*x)
    --       C: Not supported as it would increase the number of operations:
    --          (5+a)*(5-b) ==> 25 - 5*b + 5*a - a*b
    --
    -- R4) Simple factorization
    --
    --    op1 = + or -, op2/op3 = *,
    --    one literal for each innermost * operation (except in the D case),
    --    the two other terms are equals
    --
    --    Examples:
    --       A: x - (10*x)  ==> (-9)*x
    --       B: (10*x) + x  ==> 11*x
    --       C: (5*x)-(x*3) ==> 2*x
    --       D: x+x         ==> 2*x
    --
    -- R5) +/- propagation
    --
    --    ops = + or -, one literal
    --
    --    This transformation doesn't reduce the number of operations but propagates
    --    the constant to the outer level. It increases the odds that other rules
    --    will match after this one.
    --
    --    Examples:
    --       A: x - (10-y)  ==> (x+y) - 10
    --       B: (10+x) - y  ==> 10 + (x-y)
    --       C: N/A (caught by the A and B cases)
    --
    --------------------------------------------------------

    -- Rules to perform constant folding into nested expressions
    --
    --See Note [Constant folding through nested expressions]

    addFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
    addFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
    addFoldingRules PrimOp
    op NumOps
    num_ops = do
       Bool -> RuleM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (PrimOp
    op PrimOp -> PrimOp -> Bool
    forall a. Eq a => a -> a -> Bool
    == NumOps -> PrimOp
    numAdd NumOps
    num_ops)
       env <- RuleM RuleOpts
    getRuleOpts
       guard (roNumConstantFolding env)
       [arg1,arg2] <- getArgs
       platform <- getPlatform
       liftMaybe
          -- commutativity for + is handled here
          (addFoldingRules' platform arg1 arg2 num_ops
           <|> addFoldingRules' platform arg2 arg1 num_ops)

    subFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
    subFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
    subFoldingRules PrimOp
    op NumOps
    num_ops = do
       Bool -> RuleM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (PrimOp
    op PrimOp -> PrimOp -> Bool
    forall a. Eq a => a -> a -> Bool
    == NumOps -> PrimOp
    numSub NumOps
    num_ops)
       env <- RuleM RuleOpts
    getRuleOpts
       guard (roNumConstantFolding env)
       [arg1,arg2] <- getArgs
       platform <- getPlatform
       liftMaybe (subFoldingRules' platform arg1 arg2 num_ops)

    mulFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
    mulFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
    mulFoldingRules PrimOp
    op NumOps
    num_ops = do
       Bool -> RuleM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (PrimOp
    op PrimOp -> PrimOp -> Bool
    forall a. Eq a => a -> a -> Bool
    == NumOps -> PrimOp
    numMul NumOps
    num_ops)
       env <- RuleM RuleOpts
    getRuleOpts
       guard (roNumConstantFolding env)
       [arg1,arg2] <- getArgs
       platform <- getPlatform
       liftMaybe
          -- commutativity for * is handled here
          (mulFoldingRules' platform arg1 arg2 num_ops
           <|> mulFoldingRules' platform arg2 arg1 num_ops)

    andFoldingRules :: NumOps -> RuleM CoreExpr
    andFoldingRules :: NumOps -> RuleM CoreExpr
    andFoldingRules NumOps
    num_ops = do
       env <- RuleM RuleOpts
    getRuleOpts
       guard (roNumConstantFolding env)
       [arg1,arg2] <- getArgs
       platform <- getPlatform
       liftMaybe
          -- commutativity for `and` is handled here
          (andFoldingRules' platform arg1 arg2 num_ops
           <|> andFoldingRules' platform arg2 arg1 num_ops)

    orFoldingRules :: NumOps -> RuleM CoreExpr
    orFoldingRules :: NumOps -> RuleM CoreExpr
    orFoldingRules NumOps
    num_ops = do
       env <- RuleM RuleOpts
    getRuleOpts
       guard (roNumConstantFolding env)
       [arg1,arg2] <- getArgs
       platform <- getPlatform
       liftMaybe
          -- commutativity for `or` is handled here
          (orFoldingRules' platform arg1 arg2 num_ops
           <|> orFoldingRules' platform arg2 arg1 num_ops)

    quotFoldingRules :: NumOps -> RuleM CoreExpr
    quotFoldingRules :: NumOps -> RuleM CoreExpr
    quotFoldingRules NumOps
    num_ops = do
       env <- RuleM RuleOpts
    getRuleOpts
       guard (roNumConstantFolding env)
       [arg1,arg2] <- getArgs
       platform <- getPlatform
       liftMaybe (quotFoldingRules' platform arg1 arg2 num_ops)

    addFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    addFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    addFoldingRules' Platform
    platform CoreExpr
    arg1 CoreExpr
    arg2 NumOps
    num_ops = case (CoreExpr
    arg1, CoreExpr
    arg2) of

          -- x + (-y) ==> x-y
          (CoreExpr
    x, NumOps -> CoreExpr -> Maybe CoreExpr
    is_neg NumOps
    num_ops -> Just CoreExpr
    y)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    y)

          -- R1) +/- simplification

          -- l1 + (l2 + x) ==> (l1+l2) + x
          (L Integer
    l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l2,CoreExpr
    x))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    x)

          -- l1 + (l2 - x) ==> (l1+l2) - x
          (L Integer
    l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l2,CoreExpr
    x))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    x)

          -- l1 + (x - l2) ==> (l1-l2) + x
          (L Integer
    l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    x,L Integer
    l2))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    x)

          -- (l1 + x) + (l2 + y) ==> (l1+l2) + (x+y)
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l2,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y))

          -- (l1 + x) + (l2 - y) ==> (l1+l2) + (x-y)
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l2,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    y))

          -- (l1 + x) + (y - l2) ==> (l1-l2) + (x+y)
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    y,L Integer
    l2))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y))

          -- (l1 - x) + (l2 - y) ==> (l1+l2) - (x+y)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l2,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `sub` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y))

          -- (l1 - x) + (y - l2) ==> (l1-l2) + (y-x)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    y,L Integer
    l2))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    y CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    x))

          -- (x - l1) + (y - l2) ==> (0-l1-l2) + (x+y)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    x,L Integer
    l1), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    y,L Integer
    l2))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    0Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y))

          -- R4) Simple factorization

          -- x + x ==> 2 * x
          (CoreExpr, CoreExpr)
    _ | Just Integer
    l1 <- NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
    is_expr_mul NumOps
    num_ops CoreExpr
    arg1 CoreExpr
    arg2
            -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1) CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    arg1)

          -- (l1 * x) + x ==> (l1+1) * x
          (CoreExpr, CoreExpr)
    _ | Just Integer
    l1 <- NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
    is_expr_mul NumOps
    num_ops CoreExpr
    arg2 CoreExpr
    arg1
            -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1) CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    arg2)

          -- (l1 * x) + (l2 * x) ==> (l1+l2) * x
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_mul NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
    is_expr_mul NumOps
    num_ops CoreExpr
    x -> Just Integer
    l2)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    x)

          -- R5) +/- propagation: these transformations push literals outwards
          -- with the hope that other rules can then be applied.

          -- In the following rules, x can't be a literal otherwise another
          -- rule would have combined it with the other literal in arg2. So we
          -- don't have to check this to avoid loops here.

          -- x + (l1 + y) ==> l1 + (x + y)
          (CoreExpr
    _, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL Integer
    l1 CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    arg1 CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y))

          -- x + (l1 - y) ==> l1 + (x - y)
          (CoreExpr
    _, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l1,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL Integer
    l1 CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    arg1 CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    y))

          -- x + (y - l1) ==> (x + y) - l1
          (CoreExpr
    _, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    y,L Integer
    l1))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just ((CoreExpr
    arg1 CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y) CoreExpr -> CoreExpr -> CoreExpr
    `sub` Integer -> CoreExpr
    mkL Integer
    l1)

          (CoreExpr, CoreExpr)
    _ -> Maybe CoreExpr
    forall a. Maybe a
    Nothing

       where
          mkL :: Integer -> CoreExpr
    mkL = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Literal -> CoreExpr)
    -> (Integer -> Literal) -> Integer -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> NumOps -> Integer -> Literal
    mkNumLiteral Platform
    platform NumOps
    num_ops
          add :: CoreExpr -> CoreExpr -> CoreExpr
    add CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (NumOps -> PrimOp
    numAdd NumOps
    num_ops) CoreExpr
    y
          sub :: CoreExpr -> CoreExpr -> CoreExpr
    sub CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (NumOps -> PrimOp
    numSub NumOps
    num_ops) CoreExpr
    y
          mul :: CoreExpr -> CoreExpr -> CoreExpr
    mul CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (NumOps -> PrimOp
    numMul NumOps
    num_ops) CoreExpr
    y

    subFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    subFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    subFoldingRules' Platform
    platform CoreExpr
    arg1 CoreExpr
    arg2 NumOps
    num_ops = case (CoreExpr
    arg1,CoreExpr
    arg2) of
          -- x - (-y) ==> x+y
          (CoreExpr
    x, NumOps -> CoreExpr -> Maybe CoreExpr
    is_neg NumOps
    num_ops -> Just CoreExpr
    y)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y)

          -- R1) +/- simplification

          -- l1 - (l2 + x) ==> (l1-l2) - x
          (L Integer
    l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l2,CoreExpr
    x))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    x)

          -- l1 - (l2 - x) ==> (l1-l2) + x
          (L Integer
    l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l2,CoreExpr
    x))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    x)

          -- l1 - (x - l2) ==> (l1+l2) - x
          (L Integer
    l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    x, L Integer
    l2))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    x)

          -- (l1 + x) - l2 ==> (l1-l2) + x
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), L Integer
    l2)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    x)

          -- (l1 - x) - l2 ==> (l1-l2) - x
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l1,CoreExpr
    x), L Integer
    l2)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    x)

          -- (x - l1) - l2 ==> x - (l1+l2)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    x,L Integer
    l1), L Integer
    l2)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `sub` Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2))

          -- (l1 + x) - (l2 + y) ==> (l1-l2) + (x-y)
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l2,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    y))

          -- (l1 + x) - (l2 - y) ==> (l1-l2) + (x+y)
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l2,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y))

          -- (l1 + x) - (y - l2) ==> (l1+l2) + (x-y)
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    y,L Integer
    l2))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    y))

          -- (l1 - x) - (l2 + y) ==> (l1-l2) - (x+y)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l2,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `sub` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y))

          -- (x - l1) - (l2 + y) ==> (0-l1-l2) + (x-y)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    x,L Integer
    l1), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l2,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    0Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    y))

          -- (l1 - x) - (l2 - y) ==> (l1-l2) + (y-x)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l2,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    y CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    x))

          -- (l1 - x) - (y - l2) ==> (l1+l2) - (x+y)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    y,L Integer
    l2))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `sub` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y))

          -- (x - l1) - (l2 - y) ==> (0-l1-l2) + (x+y)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    x,L Integer
    l1), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l2,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    0Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y))

          -- (x - l1) - (y - l2) ==> (l2-l1) + (x-y)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    x,L Integer
    l1), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    y,L Integer
    l2))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l2Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l1) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    y))

           -- R4) Simple factorization

          -- x - (l1 * x) ==> (1-l1) * x
          (CoreExpr, CoreExpr)
    _ | Just Integer
    l1 <- NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
    is_expr_mul NumOps
    num_ops CoreExpr
    arg1 CoreExpr
    arg2
            -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l1) CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    arg1)

          -- (l1 * x) - x ==> (l1-1) * x
          (CoreExpr, CoreExpr)
    _ | Just Integer
    l1 <- NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
    is_expr_mul NumOps
    num_ops CoreExpr
    arg2 CoreExpr
    arg1
            -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    1) CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    arg2)

          -- (l1 * x) - (l2 * x) ==> (l1-l2) * x
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_mul NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
    is_expr_mul NumOps
    num_ops CoreExpr
    x -> Just Integer
    l2)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    x)

          -- R5) +/- propagation: these transformations push literals outwards
          -- with the hope that other rules can then be applied.

          -- In the following rules, x can't be a literal otherwise another
          -- rule would have combined it with the other literal in arg2. So we
          -- don't have to check this to avoid loops here.

          -- x - (l1 + y) ==> (x - y) - l1
          (CoreExpr
    _, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just ((CoreExpr
    arg1 CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    y) CoreExpr -> CoreExpr -> CoreExpr
    `sub` Integer -> CoreExpr
    mkL Integer
    l1)

          -- (l1 + x) - y ==> l1 + (x - y)
          (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), CoreExpr
    _)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL Integer
    l1 CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    arg2))

          -- x - (l1 - y) ==> (x + y) - l1
          (CoreExpr
    _, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l1,CoreExpr
    y))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just ((CoreExpr
    arg1 CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    y) CoreExpr -> CoreExpr -> CoreExpr
    `sub` Integer -> CoreExpr
    mkL Integer
    l1)

          -- x - (y - l1) ==> l1 + (x - y)
          (CoreExpr
    _, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    y,L Integer
    l1))
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL Integer
    l1 CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    arg1 CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    y))

          -- (l1 - x) - y ==> l1 - (x + y)
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l1,CoreExpr
    x), CoreExpr
    _)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL Integer
    l1 CoreExpr -> CoreExpr -> CoreExpr
    `sub` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `add` CoreExpr
    arg2))

          -- (x - l1) - y ==> (x - y) - l1
          (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    x,L Integer
    l1), CoreExpr
    _)
             -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just ((CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `sub` CoreExpr
    arg2) CoreExpr -> CoreExpr -> CoreExpr
    `sub` Integer -> CoreExpr
    mkL Integer
    l1)

          (CoreExpr, CoreExpr)
    _ -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
       where
          mkL :: Integer -> CoreExpr
    mkL = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Literal -> CoreExpr)
    -> (Integer -> Literal) -> Integer -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> NumOps -> Integer -> Literal
    mkNumLiteral Platform
    platform NumOps
    num_ops
          add :: CoreExpr -> CoreExpr -> CoreExpr
    add CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (NumOps -> PrimOp
    numAdd NumOps
    num_ops) CoreExpr
    y
          sub :: CoreExpr -> CoreExpr -> CoreExpr
    sub CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (NumOps -> PrimOp
    numSub NumOps
    num_ops) CoreExpr
    y
          mul :: CoreExpr -> CoreExpr -> CoreExpr
    mul CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (NumOps -> PrimOp
    numMul NumOps
    num_ops) CoreExpr
    y

    mulFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    mulFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    mulFoldingRules' Platform
    platform CoreExpr
    arg1 CoreExpr
    arg2 NumOps
    num_ops = case (CoreExpr
    arg1,CoreExpr
    arg2) of
       -- (-x) * (-y) ==> x*y
       (NumOps -> CoreExpr -> Maybe CoreExpr
    is_neg NumOps
    num_ops -> Just CoreExpr
    x, NumOps -> CoreExpr -> Maybe CoreExpr
    is_neg NumOps
    num_ops -> Just CoreExpr
    y)
          -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    y)

       -- l1 * (-x) ==> (-l1) * x
       (L Integer
    l1, NumOps -> CoreExpr -> Maybe CoreExpr
    is_neg NumOps
    num_ops -> Just CoreExpr
    x)
          -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (-Integer
    l1) CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    x)

       -- l1 * (l2 * x) ==> (l1*l2) * x
       (L Integer
    l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_mul NumOps
    num_ops -> Just (Integer
    l2,CoreExpr
    x))
          -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    x)

       -- l1 * (l2 + x) ==> (l1*l2) + (l1 * x)
       (L Integer
    l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops -> Just (Integer
    l2,CoreExpr
    x))
          -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `add` (CoreExpr
    arg1 CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    x))

       -- l1 * (l2 - x) ==> (l1*l2) - (l1 * x)
       (L Integer
    l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (L Integer
    l2,CoreExpr
    x))
          -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `sub` (CoreExpr
    arg1 CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    x))

       -- l1 * (x - l2) ==> (l1 * x) - (l1*l2)
       (L Integer
    l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops -> Just (CoreExpr
    x, L Integer
    l2))
          -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just ((CoreExpr
    arg1 CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    x) CoreExpr -> CoreExpr -> CoreExpr
    `sub` Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    l2))

       -- (l1 * x) * (l2 * y) ==> (l1*l2) * (x * y)
       (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_mul NumOps
    num_ops -> Just (Integer
    l1,CoreExpr
    x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_mul NumOps
    num_ops -> Just (Integer
    l2,CoreExpr
    y))
          -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `mul` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `mul` CoreExpr
    y))

       (CoreExpr, CoreExpr)
    _ -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
       where
          mkL :: Integer -> CoreExpr
    mkL = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Literal -> CoreExpr)
    -> (Integer -> Literal) -> Integer -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> NumOps -> Integer -> Literal
    mkNumLiteral Platform
    platform NumOps
    num_ops
          add :: CoreExpr -> CoreExpr -> CoreExpr
    add CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (NumOps -> PrimOp
    numAdd NumOps
    num_ops) CoreExpr
    y
          sub :: CoreExpr -> CoreExpr -> CoreExpr
    sub CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (NumOps -> PrimOp
    numSub NumOps
    num_ops) CoreExpr
    y
          mul :: CoreExpr -> CoreExpr -> CoreExpr
    mul CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (NumOps -> PrimOp
    numMul NumOps
    num_ops) CoreExpr
    y

    andFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    andFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    andFoldingRules' Platform
    platform CoreExpr
    arg1 CoreExpr
    arg2 NumOps
    num_ops = case (CoreExpr
    arg1, CoreExpr
    arg2) of
        -- R2) * `or` `and` simplifications
        -- l1 and (l2 and x) ==> (l1 and l2) and x
        (L Integer
    l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_and NumOps
    num_ops -> Just (Integer
    l2, CoreExpr
    x))
           -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .&. Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `and` CoreExpr
    x)

        -- l1 and (l2 or x) ==> (l1 and l2) or (l1 and x)
        -- does not decrease operations

        -- (l1 and x) and (l2 and y) ==> (l1 and l2) and (x and y)
        (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_and NumOps
    num_ops -> Just (Integer
    l1, CoreExpr
    x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_and NumOps
    num_ops -> Just (Integer
    l2, CoreExpr
    y))
           -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .&. Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `and` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `and` CoreExpr
    y))

        -- (l1 and x) and (l2 or y) ==> (l1 and l2 and x) or (l1 and x and y)
        -- (l1 or x) and (l2 or y) ==> (l1 and l2) or (x and l2) or (l1 and y) or (x and y)
        -- increase operation numbers

        (CoreExpr, CoreExpr)
    _ -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
        where
          mkL :: Integer -> CoreExpr
    mkL = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Literal -> CoreExpr)
    -> (Integer -> Literal) -> Integer -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> NumOps -> Integer -> Literal
    mkNumLiteral Platform
    platform NumOps
    num_ops
          and :: CoreExpr -> CoreExpr -> CoreExpr
    and CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (Maybe PrimOp -> PrimOp
    forall a. HasCallStack => Maybe a -> a
    fromJust (NumOps -> Maybe PrimOp
    numAnd NumOps
    num_ops)) CoreExpr
    y

    orFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    orFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    orFoldingRules' Platform
    platform CoreExpr
    arg1 CoreExpr
    arg2 NumOps
    num_ops = case (CoreExpr
    arg1, CoreExpr
    arg2) of
        -- R2) *  `or` `and` simplifications
        -- l1 or (l2 or x) ==> (l1 or l2) or x
        (L Integer
    l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_or NumOps
    num_ops -> Just (Integer
    l2, CoreExpr
    x))
           -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .|. Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `or` CoreExpr
    x)

        -- l1 or (l2 and x) ==> (l1 or l2) and (l1 and x)
        -- does not decrease operations

        -- (l1 or x) or (l2 or y) ==> (l1 or l2) or (x or y)
        (NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_or NumOps
    num_ops -> Just (Integer
    l1, CoreExpr
    x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_or NumOps
    num_ops -> Just (Integer
    l2, CoreExpr
    y))
           -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Integer -> CoreExpr
    mkL (Integer
    l1 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .|. Integer
    l2) CoreExpr -> CoreExpr -> CoreExpr
    `or` (CoreExpr
    x CoreExpr -> CoreExpr -> CoreExpr
    `or` CoreExpr
    y))

        -- (l1 and x) or (l2 or y) ==> (l1 and l2 and x) or (l1 and x and y)
        -- (l1 and x) or (l2 and y) ==> (l1 and l2) or (x and l2) or (l1 and y) or (x and y)
        -- increase operation numbers

        (CoreExpr, CoreExpr)
    _ -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
        where
          mkL :: Integer -> CoreExpr
    mkL = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Literal -> CoreExpr)
    -> (Integer -> Literal) -> Integer -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> NumOps -> Integer -> Literal
    mkNumLiteral Platform
    platform NumOps
    num_ops
          or :: CoreExpr -> CoreExpr -> CoreExpr
    or CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (Maybe PrimOp -> PrimOp
    forall a. HasCallStack => Maybe a -> a
    fromJust (NumOps -> Maybe PrimOp
    numOr NumOps
    num_ops)) CoreExpr
    y

    quotFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    quotFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
    quotFoldingRules' Platform
    platform CoreExpr
    arg1 CoreExpr
    arg2 NumOps
    num_ops = case (CoreExpr
    arg1, CoreExpr
    arg2) of

      -- (x / l1) / l2
      -- l1 and l2 /= 0
      -- l1*l2 doesn't overflow
      -- ==> x / (l1 * l2)
      (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_div NumOps
    num_ops -> Just (CoreExpr
    x, L Integer
    l1), L Integer
    l2)
        | Integer
    l1 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0
        , Integer
    l2 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0
        -- check that the result of the multiplication is in range
        , Just Literal
    l <- Platform -> NumOps -> Integer -> Maybe Literal
    mkNumLiteralMaybe Platform
    platform NumOps
    num_ops (Integer
    l1 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    l2)
        -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> CoreExpr -> CoreExpr
    div CoreExpr
    x (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit Literal
    l))
          -- NB: we could directly return 0 or (-1) in case of overflow,
          -- but we would need to know
          --  (1) if we're dealing with a quot or a div operation
          --  (2) if it's an underflow or an overflow.
          -- Left as future work for now.

      (CoreExpr, CoreExpr)
    _ -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
      where
        div :: CoreExpr -> CoreExpr -> CoreExpr
    div CoreExpr
    x CoreExpr
    y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x (Maybe PrimOp -> PrimOp
    forall a. HasCallStack => Maybe a -> a
    fromJust (NumOps -> Maybe PrimOp
    numDiv NumOps
    num_ops)) CoreExpr
    y

    is_binop :: PrimOp -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)
    is_binop :: PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_binop PrimOp
    op CoreExpr
    e = case CoreExpr
    e of
     BinOpApp CoreExpr
    x PrimOp
    op' CoreExpr
    y | PrimOp
    op PrimOp -> PrimOp -> Bool
    forall a. Eq a => a -> a -> Bool
    == PrimOp
    op' -> (CoreExpr, CoreExpr) -> Maybe (CoreExpr, CoreExpr)
    forall a. a -> Maybe a
    Just (CoreExpr
    x,CoreExpr
    y)
     CoreExpr
    _                            -> Maybe (CoreExpr, CoreExpr)
    forall a. Maybe a
    Nothing

    is_op :: PrimOp -> CoreExpr -> Maybe (Arg CoreBndr)
    is_op :: PrimOp -> CoreExpr -> Maybe CoreExpr
    is_op PrimOp
    op CoreExpr
    e = case CoreExpr
    e of
     App (OpVal PrimOp
    op') CoreExpr
    x | PrimOp
    op PrimOp -> PrimOp -> Bool
    forall a. Eq a => a -> a -> Bool
    == PrimOp
    op' -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just CoreExpr
    x
     CoreExpr
    _                             -> Maybe CoreExpr
    forall a. Maybe a
    Nothing

    is_add, is_sub, is_mul, is_and, is_or, is_div :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)
    is_add :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_add NumOps
    num_ops CoreExpr
    e = PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_binop (NumOps -> PrimOp
    numAdd NumOps
    num_ops) CoreExpr
    e
    is_sub :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_sub NumOps
    num_ops CoreExpr
    e = PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_binop (NumOps -> PrimOp
    numSub NumOps
    num_ops) CoreExpr
    e
    is_mul :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_mul NumOps
    num_ops CoreExpr
    e = PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_binop (NumOps -> PrimOp
    numMul NumOps
    num_ops) CoreExpr
    e
    is_and :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_and NumOps
    num_ops CoreExpr
    e = NumOps -> Maybe PrimOp
    numAnd NumOps
    num_ops Maybe PrimOp
    -> (PrimOp -> Maybe (CoreExpr, CoreExpr))
    -> Maybe (CoreExpr, CoreExpr)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \PrimOp
    op -> PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_binop PrimOp
    op CoreExpr
    e
    is_or :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_or  NumOps
    num_ops CoreExpr
    e = NumOps -> Maybe PrimOp
    numOr  NumOps
    num_ops Maybe PrimOp
    -> (PrimOp -> Maybe (CoreExpr, CoreExpr))
    -> Maybe (CoreExpr, CoreExpr)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \PrimOp
    op -> PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_binop PrimOp
    op CoreExpr
    e
    is_div :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_div NumOps
    num_ops CoreExpr
    e = NumOps -> Maybe PrimOp
    numDiv NumOps
    num_ops Maybe PrimOp
    -> (PrimOp -> Maybe (CoreExpr, CoreExpr))
    -> Maybe (CoreExpr, CoreExpr)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \PrimOp
    op -> PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_binop PrimOp
    op CoreExpr
    e

    is_neg :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr)
    is_neg :: NumOps -> CoreExpr -> Maybe CoreExpr
    is_neg NumOps
    num_ops CoreExpr
    e = NumOps -> Maybe PrimOp
    numNeg NumOps
    num_ops Maybe PrimOp -> (PrimOp -> Maybe CoreExpr) -> Maybe CoreExpr
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \PrimOp
    op -> PrimOp -> CoreExpr -> Maybe CoreExpr
    is_op PrimOp
    op CoreExpr
    e

    -- match operation with a literal (handles commutativity)
    is_lit_add, is_lit_mul, is_lit_and, is_lit_or :: NumOps -> CoreExpr -> Maybe (Integer, Arg CoreBndr)
    is_lit_add :: NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_add NumOps
    num_ops CoreExpr
    e = (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
    -> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_add NumOps
    num_ops CoreExpr
    e
    is_lit_mul :: NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_mul NumOps
    num_ops CoreExpr
    e = (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
    -> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_mul NumOps
    num_ops CoreExpr
    e
    is_lit_and :: NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_and NumOps
    num_ops CoreExpr
    e = (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
    -> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_and NumOps
    num_ops CoreExpr
    e
    is_lit_or :: NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_or  NumOps
    num_ops CoreExpr
    e = (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
    -> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    is_or  NumOps
    num_ops CoreExpr
    e

    is_lit' :: (NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)) -> NumOps -> CoreExpr -> Maybe (Integer, Arg CoreBndr)
    is_lit' :: (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
    -> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    f NumOps
    num_ops CoreExpr
    e = case NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
    f NumOps
    num_ops CoreExpr
    e of
      Just (L Integer
    l, CoreExpr
    x  ) -> (Integer, CoreExpr) -> Maybe (Integer, CoreExpr)
    forall a. a -> Maybe a
    Just (Integer
    l,CoreExpr
    x)
      Just (CoreExpr
    x  , L Integer
    l) -> (Integer, CoreExpr) -> Maybe (Integer, CoreExpr)
    forall a. a -> Maybe a
    Just (Integer
    l,CoreExpr
    x)
      Maybe (CoreExpr, CoreExpr)
    _               -> Maybe (Integer, CoreExpr)
    forall a. Maybe a
    Nothing

    -- match given "x": return 1
    -- match "lit * x": return lit value (handles commutativity)
    is_expr_mul :: NumOps -> Expr CoreBndr -> Expr CoreBndr -> Maybe Integer
    is_expr_mul :: NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
    is_expr_mul NumOps
    num_ops CoreExpr
    x CoreExpr
    e = if
       | CoreExpr
    x CoreExpr -> CoreExpr -> Bool
    forall b. Expr b -> Expr b -> Bool
    `cheapEqExpr` CoreExpr
    e
       -> Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    1
       | Just (Integer
    k,CoreExpr
    x') <- NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
    is_lit_mul NumOps
    num_ops CoreExpr
    e
       , CoreExpr
    x CoreExpr -> CoreExpr -> Bool
    forall b. Expr b -> Expr b -> Bool
    `cheapEqExpr` CoreExpr
    x'
       -> Integer -> Maybe Integer
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    k
       | Bool
    otherwise
       -> Maybe Integer
    forall a. Maybe a
    Nothing

    -- | Match the application of a binary primop
    pattern BinOpApp :: Arg CoreBndr -> PrimOp -> Arg CoreBndr -> CoreExpr
    pattern $mBinOpApp :: forall {r}.
    CoreExpr
    -> (CoreExpr -> PrimOp -> CoreExpr -> r) -> ((# #) -> r) -> r
    $bBinOpApp :: CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp x op y = OpVal op `App` x `App` y

    -- | Match a primop
    pattern OpVal:: PrimOp  -> Arg CoreBndr
    pattern $mOpVal :: forall {r}. CoreExpr -> (PrimOp -> r) -> ((# #) -> r) -> r
    $bOpVal :: PrimOp -> CoreExpr
    OpVal op <- Var (isPrimOpId_maybe -> Just op) where
       OpVal PrimOp
    op = Id -> CoreExpr
    forall b. Id -> Expr b
    Var (PrimOp -> Id
    primOpId PrimOp
    op)

    -- | Match a literal
    pattern L :: Integer -> Arg CoreBndr
    pattern $mL :: forall {r}. CoreExpr -> (Integer -> r) -> ((# #) -> r) -> r
    L i <- Lit (LitNumber _ i)

    -- | Explicit "type-class"-like dictionary for numeric primops
    data NumOps = NumOps
       { NumOps -> PrimOp
    numAdd     :: !PrimOp         -- ^ Add two numbers
       , NumOps -> PrimOp
    numSub     :: !PrimOp         -- ^ Sub two numbers
       , NumOps -> PrimOp
    numMul     :: !PrimOp         -- ^ Multiply two numbers
       , NumOps -> Maybe PrimOp
    numDiv     :: !(Maybe PrimOp) -- ^ Divide two numbers
       , NumOps -> Maybe PrimOp
    numAnd     :: !(Maybe PrimOp) -- ^ And two numbers
       , NumOps -> Maybe PrimOp
    numOr      :: !(Maybe PrimOp) -- ^ Or two numbers
       , NumOps -> Maybe PrimOp
    numNeg     :: !(Maybe PrimOp) -- ^ Negate a number
       , NumOps -> LitNumType
    numLitType :: !LitNumType     -- ^ Literal type
       }

    -- | Create a numeric literal
    mkNumLiteral :: Platform -> NumOps -> Integer -> Literal
    mkNumLiteral :: Platform -> NumOps -> Integer -> Literal
    mkNumLiteral Platform
    platform NumOps
    ops Integer
    i = Platform -> LitNumType -> Integer -> Literal
    mkLitNumberWrap Platform
    platform (NumOps -> LitNumType
    numLitType NumOps
    ops) Integer
    i

    -- | Create a numeric literal if it is in range
    mkNumLiteralMaybe :: Platform -> NumOps -> Integer -> Maybe Literal
    mkNumLiteralMaybe :: Platform -> NumOps -> Integer -> Maybe Literal
    mkNumLiteralMaybe Platform
    platform NumOps
    ops Integer
    i = Platform -> LitNumType -> Integer -> Maybe Literal
    mkLitNumberMaybe Platform
    platform (NumOps -> LitNumType
    numLitType NumOps
    ops) Integer
    i

    int8Ops :: NumOps
    int8Ops :: NumOps
    int8Ops = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    Int8AddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    Int8SubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    Int8MulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Int8QuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numOr :: Maybe PrimOp
    numOr      = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numNeg :: Maybe PrimOp
    numNeg     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Int8NegOp
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumInt8
       }

    word8Ops :: NumOps
    word8Ops :: NumOps
    word8Ops = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    Word8AddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    Word8SubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    Word8MulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word8QuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word8AndOp
       , numOr :: Maybe PrimOp
    numOr      = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word8OrOp
       , numNeg :: Maybe PrimOp
    numNeg     = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumWord8
       }

    int16Ops :: NumOps
    int16Ops :: NumOps
    int16Ops = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    Int16AddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    Int16SubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    Int16MulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Int16QuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numOr :: Maybe PrimOp
    numOr      = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numNeg :: Maybe PrimOp
    numNeg     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Int16NegOp
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumInt16
       }

    word16Ops :: NumOps
    word16Ops :: NumOps
    word16Ops = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    Word16AddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    Word16SubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    Word16MulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word16QuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word16AndOp
       , numOr :: Maybe PrimOp
    numOr      = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word16OrOp
       , numNeg :: Maybe PrimOp
    numNeg     = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumWord16
       }

    int32Ops :: NumOps
    int32Ops :: NumOps
    int32Ops = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    Int32AddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    Int32SubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    Int32MulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Int32QuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numOr :: Maybe PrimOp
    numOr      = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numNeg :: Maybe PrimOp
    numNeg     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Int32NegOp
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumInt32
       }

    word32Ops :: NumOps
    word32Ops :: NumOps
    word32Ops = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    Word32AddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    Word32SubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    Word32MulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word32QuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word32AndOp
       , numOr :: Maybe PrimOp
    numOr      = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word32OrOp
       , numNeg :: Maybe PrimOp
    numNeg     = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumWord32
       }

    int64Ops :: NumOps
    int64Ops :: NumOps
    int64Ops = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    Int64AddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    Int64SubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    Int64MulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Int64QuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numOr :: Maybe PrimOp
    numOr      = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numNeg :: Maybe PrimOp
    numNeg     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Int64NegOp
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumInt64
       }

    word64Ops :: NumOps
    word64Ops :: NumOps
    word64Ops = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    Word64AddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    Word64SubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    Word64MulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word64QuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word64AndOp
       , numOr :: Maybe PrimOp
    numOr      = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    Word64OrOp
       , numNeg :: Maybe PrimOp
    numNeg     = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumWord64
       }

    intOps :: NumOps
    intOps :: NumOps
    intOps = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    IntAddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    IntSubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    IntMulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    IntQuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    IntAndOp
       , numOr :: Maybe PrimOp
    numOr      = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    IntOrOp
       , numNeg :: Maybe PrimOp
    numNeg     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    IntNegOp
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumInt
       }

    wordOps :: NumOps
    wordOps :: NumOps
    wordOps = NumOps
       { numAdd :: PrimOp
    numAdd     = PrimOp
    WordAddOp
       , numSub :: PrimOp
    numSub     = PrimOp
    WordSubOp
       , numMul :: PrimOp
    numMul     = PrimOp
    WordMulOp
       , numDiv :: Maybe PrimOp
    numDiv     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    WordQuotOp
       , numAnd :: Maybe PrimOp
    numAnd     = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    WordAndOp
       , numOr :: Maybe PrimOp
    numOr      = PrimOp -> Maybe PrimOp
    forall a. a -> Maybe a
    Just PrimOp
    WordOrOp
       , numNeg :: Maybe PrimOp
    numNeg     = Maybe PrimOp
    forall a. Maybe a
    Nothing
       , numLitType :: LitNumType
    numLitType = LitNumType
    LitNumWord
       }

    --------------------------------------------------------
    -- Constant folding through case-expressions
    --
    -- cf Scrutinee Constant Folding in simplCore/GHC.Core.Opt.Simplify.Utils
    --------------------------------------------------------

    -- | Match the scrutinee of a case and potentially return a new scrutinee and a
    -- function to apply to each literal alternative.
    caseRules :: Platform
              -> CoreExpr                       -- Scrutinee
              -> Maybe ( CoreExpr               -- New scrutinee
                       , AltCon -> Maybe AltCon -- How to fix up the alt pattern
                                                --   Nothing <=> Unreachable
                                                -- See Note [Unreachable caseRules alternatives]
                       , Id -> CoreExpr)        -- How to reconstruct the original scrutinee
                                                -- from the new case-binder
    -- e.g  case e of b {
    --         ...;
    --         con bs -> rhs;
    --         ... }
    --  ==>
    --      case e' of b' {
    --         ...;
    --         fixup_altcon[con] bs -> let b = mk_orig[b] in rhs;
    --         ... }

    caseRules :: Platform
    -> CoreExpr
    -> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    caseRules Platform
    platform (App (App (Var Id
    f) CoreExpr
    v) (Lit Literal
    l))   -- v `op` x#
      | Just PrimOp
    op <- Id -> Maybe PrimOp
    isPrimOpId_maybe Id
    f
      , LitNumber LitNumType
    _ Integer
    x <- Literal
    l
      , Just Integer -> Integer
    adjust_lit <- PrimOp -> Integer -> Maybe (Integer -> Integer)
    adjustDyadicRight PrimOp
    op Integer
    x
      = (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    -> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    forall a. a -> Maybe a
    Just (CoreExpr
    v, Platform -> (Integer -> Integer) -> AltCon -> Maybe AltCon
    tx_lit_con Platform
    platform Integer -> Integer
    adjust_lit
               , \Id
    v -> (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    f) (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    v)) (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit Literal
    l)))

    caseRules Platform
    platform (App (App (Var Id
    f) (Lit Literal
    l)) CoreExpr
    v)   -- x# `op` v
      | Just PrimOp
    op <- Id -> Maybe PrimOp
    isPrimOpId_maybe Id
    f
      , LitNumber LitNumType
    _ Integer
    x <- Literal
    l
      , Just Integer -> Integer
    adjust_lit <- Integer -> PrimOp -> Maybe (Integer -> Integer)
    adjustDyadicLeft Integer
    x PrimOp
    op
      = (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    -> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    forall a. a -> Maybe a
    Just (CoreExpr
    v, Platform -> (Integer -> Integer) -> AltCon -> Maybe AltCon
    tx_lit_con Platform
    platform Integer -> Integer
    adjust_lit
               , \Id
    v -> (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    f) (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit Literal
    l)) (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    v)))

    caseRules Platform
    platform (App (Var Id
    f) CoreExpr
    v              )   -- op v
      | Just PrimOp
    op <- Id -> Maybe PrimOp
    isPrimOpId_maybe Id
    f
      , Just Integer -> Integer
    adjust_lit <- PrimOp -> Maybe (Integer -> Integer)
    adjustUnary PrimOp
    op
      = (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    -> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    forall a. a -> Maybe a
    Just (CoreExpr
    v, Platform -> (Integer -> Integer) -> AltCon -> Maybe AltCon
    tx_lit_con Platform
    platform Integer -> Integer
    adjust_lit
               , \Id
    v -> CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    f) (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    v))

    -- See Note [caseRules for tagToEnum]
    caseRules Platform
    platform (App (App (Var Id
    f) CoreExpr
    type_arg) CoreExpr
    v)
      | Just PrimOp
    TagToEnumOp <- Id -> Maybe PrimOp
    isPrimOpId_maybe Id
    f
      = (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    -> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    forall a. a -> Maybe a
    Just (CoreExpr
    v, Platform -> AltCon -> Maybe AltCon
    tx_con_tte Platform
    platform
               , \Id
    v -> (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    f) CoreExpr
    type_arg) (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    v)))

    -- See Note [caseRules for dataToTag]
    caseRules Platform
    _ (Var Id
    f `App` Type Type
    lev `App` Type Type
    ty `App` CoreExpr
    v) -- dataToTag x
      | Just PrimOp
    op <- Id -> Maybe PrimOp
    isPrimOpId_maybe Id
    f
      , PrimOp
    op PrimOp -> PrimOp -> Bool
    forall a. Eq a => a -> a -> Bool
    == PrimOp
    DataToTagSmallOp Bool -> Bool -> Bool
    || PrimOp
    op PrimOp -> PrimOp -> Bool
    forall a. Eq a => a -> a -> Bool
    == PrimOp
    DataToTagLargeOp
      = case HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty of
          Just (TyCon
    tc, [Type]
    _) | TyCon -> Bool
    isValidDTT2TyCon TyCon
    tc
            -> (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    -> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    forall a. a -> Maybe a
    Just (CoreExpr
    v, TyCon -> AltCon -> Maybe AltCon
    tx_con_dtt TyCon
    tc
                    , \Id
    v' -> Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    f CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    lev CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    ty CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App` Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    v')
          Maybe (TyCon, [Type])
    _ -> SDoc
    -> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    -> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    forall a. HasCallStack => SDoc -> a -> a
    pprTraceUserWarning SDoc
    warnMsg Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    forall a. Maybe a
    Nothing
      where
        warnMsg :: SDoc
    warnMsg = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (String -> SDoc) -> [String] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> SDoc
    forall doc. IsLine doc => String -> doc
    text
          [ String
    "Found dataToTag primop applied to a non-ADT type. This could"
          , String
    "be a future bug in GHC, or it may be caused by an unsupported"
          , String
    "use of the ghc-internal primops dataToTagSmall# and dataToTagLarge#."
          , String
    "In either case, the GHC developers would like to know about it!"
          , String
    "Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug"
          ]

    caseRules Platform
    _ CoreExpr
    _ = Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
    forall a. Maybe a
    Nothing

    -- | Case rules
    --
    -- It's important that occurrence info are present, hence the use of In* types.
    caseRules2
       :: InExpr  -- ^ Scutinee
       -> InId    -- ^ Case-binder
       -> [InAlt] -- ^ Alternatives in standard (increasing) order
       -> Maybe (InExpr, InId, [InAlt])
    caseRules2 :: CoreExpr -> Id -> [CoreAlt] -> Maybe (CoreExpr, Id, [CoreAlt])
    caseRules2 CoreExpr
    scrut Id
    bndr [CoreAlt]
    alts

      -- case quotRem# x y of
      --    (# q, _ #) -> body
      -- ====>
      --  case quot# x y of
      --    q -> body
      --
      -- case quotRem# x y of
      --    (# _, r #) -> body
      -- ====>
      --  case rem# x y of
      --    r -> body
      | BinOpApp CoreExpr
    x PrimOp
    op CoreExpr
    y <- CoreExpr
    scrut
      , Just (PrimOp
    quot,PrimOp
    rem) <- PrimOp -> Maybe (PrimOp, PrimOp)
    is_any_quot_rem PrimOp
    op
      , [Alt (DataAlt DataCon
    _) [Id
    q,Id
    r] CoreExpr
    body] <- [CoreAlt]
    alts
      , Id -> Bool
    isDeadBinder Id
    bndr
      , Bool
    dead_q <- Id -> Bool
    isDeadBinder Id
    q
      , Bool
    dead_r <- Id -> Bool
    isDeadBinder Id
    r
      , Bool
    dead_q Bool -> Bool -> Bool
    || Bool
    dead_r
      = if
          | Bool
    dead_q    -> (CoreExpr, Id, [CoreAlt]) -> Maybe (CoreExpr, Id, [CoreAlt])
    forall a. a -> Maybe a
    Just ((CoreExpr, Id, [CoreAlt]) -> Maybe (CoreExpr, Id, [CoreAlt]))
    -> (CoreExpr, Id, [CoreAlt]) -> Maybe (CoreExpr, Id, [CoreAlt])
    forall a b. (a -> b) -> a -> b
    $ (CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x PrimOp
    rem  CoreExpr
    y, Id
    r, [AltCon -> [Id] -> CoreExpr -> CoreAlt
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT [] CoreExpr
    body])
          | Bool
    dead_r    -> (CoreExpr, Id, [CoreAlt]) -> Maybe (CoreExpr, Id, [CoreAlt])
    forall a. a -> Maybe a
    Just ((CoreExpr, Id, [CoreAlt]) -> Maybe (CoreExpr, Id, [CoreAlt]))
    -> (CoreExpr, Id, [CoreAlt]) -> Maybe (CoreExpr, Id, [CoreAlt])
    forall a b. (a -> b) -> a -> b
    $ (CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
    BinOpApp CoreExpr
    x PrimOp
    quot CoreExpr
    y, Id
    q, [AltCon -> [Id] -> CoreExpr -> CoreAlt
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT [] CoreExpr
    body])
          | Bool
    otherwise -> Maybe (CoreExpr, Id, [CoreAlt])
    forall a. Maybe a
    Nothing

      | Bool
    otherwise
      = Maybe (CoreExpr, Id, [CoreAlt])
    forall a. Maybe a
    Nothing

    -- | If the given primop is a quotRem, return the corresponding (quot,rem).
    is_any_quot_rem :: PrimOp -> Maybe (PrimOp, PrimOp)
    is_any_quot_rem :: PrimOp -> Maybe (PrimOp, PrimOp)
    is_any_quot_rem = \case
      PrimOp
    IntQuotRemOp    -> (PrimOp, PrimOp) -> Maybe (PrimOp, PrimOp)
    forall a. a -> Maybe a
    Just (PrimOp
    IntQuotOp ,  PrimOp
    IntRemOp)
      PrimOp
    Int8QuotRemOp   -> (PrimOp, PrimOp) -> Maybe (PrimOp, PrimOp)
    forall a. a -> Maybe a
    Just (PrimOp
    Int8QuotOp,  PrimOp
    Int8RemOp)
      PrimOp
    Int16QuotRemOp  -> (PrimOp, PrimOp) -> Maybe (PrimOp, PrimOp)
    forall a. a -> Maybe a
    Just (PrimOp
    Int16QuotOp, PrimOp
    Int16RemOp)
      PrimOp
    Int32QuotRemOp  -> (PrimOp, PrimOp) -> Maybe (PrimOp, PrimOp)
    forall a. a -> Maybe a
    Just (PrimOp
    Int32QuotOp, PrimOp
    Int32RemOp)
      -- Int64QuotRemOp doesn't exist (yet)

      PrimOp
    WordQuotRemOp   -> (PrimOp, PrimOp) -> Maybe (PrimOp, PrimOp)
    forall a. a -> Maybe a
    Just (PrimOp
    WordQuotOp,   PrimOp
    WordRemOp)
      PrimOp
    Word8QuotRemOp  -> (PrimOp, PrimOp) -> Maybe (PrimOp, PrimOp)
    forall a. a -> Maybe a
    Just (PrimOp
    Word8QuotOp,  PrimOp
    Word8RemOp)
      PrimOp
    Word16QuotRemOp -> (PrimOp, PrimOp) -> Maybe (PrimOp, PrimOp)
    forall a. a -> Maybe a
    Just (PrimOp
    Word16QuotOp, PrimOp
    Word16RemOp)
      PrimOp
    Word32QuotRemOp -> (PrimOp, PrimOp) -> Maybe (PrimOp, PrimOp)
    forall a. a -> Maybe a
    Just (PrimOp
    Word32QuotOp, PrimOp
    Word32RemOp)
      -- Word64QuotRemOp doesn't exist (yet)

      PrimOp
    _ -> Maybe (PrimOp, PrimOp)
    forall a. Maybe a
    Nothing

    tx_lit_con :: Platform -> (Integer -> Integer) -> AltCon -> Maybe AltCon
    tx_lit_con :: Platform -> (Integer -> Integer) -> AltCon -> Maybe AltCon
    tx_lit_con Platform
    _        Integer -> Integer
    _      AltCon
    DEFAULT    = AltCon -> Maybe AltCon
    forall a. a -> Maybe a
    Just AltCon
    DEFAULT
    tx_lit_con Platform
    platform Integer -> Integer
    adjust (LitAlt Literal
    l) = AltCon -> Maybe AltCon
    forall a. a -> Maybe a
    Just (AltCon -> Maybe AltCon) -> AltCon -> Maybe AltCon
    forall a b. (a -> b) -> a -> b
    $ Literal -> AltCon
    LitAlt (Platform -> (Integer -> Integer) -> Literal -> Literal
    mapLitValue Platform
    platform Integer -> Integer
    adjust Literal
    l)
    tx_lit_con Platform
    _        Integer -> Integer
    _      AltCon
    alt        = String -> SDoc -> Maybe AltCon
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "caseRules" (AltCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AltCon
    alt)
       -- NB: mapLitValue uses mkLitIntWrap etc, to ensure that the
       -- literal alternatives remain in Word/Int target ranges
       -- (See Note [Word/Int underflow/overflow] in GHC.Types.Literal and #13172).

    adjustDyadicRight :: PrimOp -> Integer -> Maybe (Integer -> Integer)
    -- Given (x `op` lit) return a function 'f' s.t.  f (x `op` lit) = x
    adjustDyadicRight :: PrimOp -> Integer -> Maybe (Integer -> Integer)
    adjustDyadicRight PrimOp
    op Integer
    lit
      = case PrimOp
    op of
             PrimOp
    WordAddOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    lit      )
             PrimOp
    IntAddOp  -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    lit      )
             PrimOp
    WordSubOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    lit      )
             PrimOp
    IntSubOp  -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    lit      )
             PrimOp
    WordXorOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    y Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    `xor` Integer
    lit)
             PrimOp
    IntXorOp  -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    y Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    `xor` Integer
    lit)
             PrimOp
    _         -> Maybe (Integer -> Integer)
    forall a. Maybe a
    Nothing

    adjustDyadicLeft :: Integer -> PrimOp -> Maybe (Integer -> Integer)
    -- Given (lit `op` x) return a function 'f' s.t.  f (lit `op` x) = x
    adjustDyadicLeft :: Integer -> PrimOp -> Maybe (Integer -> Integer)
    adjustDyadicLeft Integer
    lit PrimOp
    op
      = case PrimOp
    op of
             PrimOp
    WordAddOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    lit      )
             PrimOp
    IntAddOp  -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    lit      )
             PrimOp
    WordSubOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    litInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    y      )
             PrimOp
    IntSubOp  -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    litInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    y      )
             PrimOp
    WordXorOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    y Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    `xor` Integer
    lit)
             PrimOp
    IntXorOp  -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer
    y Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    `xor` Integer
    lit)
             PrimOp
    _         -> Maybe (Integer -> Integer)
    forall a. Maybe a
    Nothing

    adjustUnary :: PrimOp -> Maybe (Integer -> Integer)
    -- Given (op x) return a function 'f' s.t.  f (op x) = x
    adjustUnary :: PrimOp -> Maybe (Integer -> Integer)
    adjustUnary PrimOp
    op
      = case PrimOp
    op of
             PrimOp
    WordNotOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer -> Integer
    forall a. Bits a => a -> a
    complement Integer
    y)
             PrimOp
    IntNotOp  -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer -> Integer
    forall a. Bits a => a -> a
    complement Integer
    y)
             PrimOp
    IntNegOp  -> (Integer -> Integer) -> Maybe (Integer -> Integer)
    forall a. a -> Maybe a
    Just (\Integer
    y -> Integer -> Integer
    forall a. Num a => a -> a
    negate Integer
    y    )
             PrimOp
    _         -> Maybe (Integer -> Integer)
    forall a. Maybe a
    Nothing

    tx_con_tte :: Platform -> AltCon -> Maybe AltCon
    tx_con_tte :: Platform -> AltCon -> Maybe AltCon
    tx_con_tte Platform
    _        AltCon
    DEFAULT         = AltCon -> Maybe AltCon
    forall a. a -> Maybe a
    Just AltCon
    DEFAULT
    tx_con_tte Platform
    _        alt :: AltCon
    alt@(LitAlt {}) = String -> SDoc -> Maybe AltCon
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "caseRules" (AltCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AltCon
    alt)
    tx_con_tte Platform
    platform (DataAlt DataCon
    dc)  -- See Note [caseRules for tagToEnum]
      = AltCon -> Maybe AltCon
    forall a. a -> Maybe a
    Just (AltCon -> Maybe AltCon) -> AltCon -> Maybe AltCon
    forall a b. (a -> b) -> a -> b
    $ Literal -> AltCon
    LitAlt (Literal -> AltCon) -> Literal -> AltCon
    forall a b. (a -> b) -> a -> b
    $ Platform -> Integer -> Literal
    mkLitInt Platform
    platform (Integer -> Literal) -> Integer -> Literal
    forall a b. (a -> b) -> a -> b
    $ ConTagZ -> Integer
    forall a. Integral a => a -> Integer
    toInteger (ConTagZ -> Integer) -> ConTagZ -> Integer
    forall a b. (a -> b) -> a -> b
    $ DataCon -> ConTagZ
    dataConTagZ DataCon
    dc

    tx_con_dtt :: TyCon -> AltCon -> Maybe AltCon
    tx_con_dtt :: TyCon -> AltCon -> Maybe AltCon
    tx_con_dtt TyCon
    _  AltCon
    DEFAULT = AltCon -> Maybe AltCon
    forall a. a -> Maybe a
    Just AltCon
    DEFAULT
    tx_con_dtt TyCon
    tc (LitAlt (LitNumber LitNumType
    LitNumInt Integer
    i))
       | ConTagZ
    tag ConTagZ -> ConTagZ -> Bool
    forall a. Ord a => a -> a -> Bool
    >= ConTagZ
    0
       , ConTagZ
    tag ConTagZ -> ConTagZ -> Bool
    forall a. Ord a => a -> a -> Bool
    < ConTagZ
    n_data_cons
       = AltCon -> Maybe AltCon
    forall a. a -> Maybe a
    Just (DataCon -> AltCon
    DataAlt ([DataCon]
    data_cons [DataCon] -> ConTagZ -> DataCon
    forall a. HasCallStack => [a] -> ConTagZ -> a
    !! ConTagZ
    tag))   -- tag is zero-indexed, as is (!!)
       | Bool
    otherwise
       = Maybe AltCon
    forall a. Maybe a
    Nothing
       where
         tag :: ConTagZ
    tag         = Integer -> ConTagZ
    forall a. Num a => Integer -> a
    fromInteger Integer
    i :: ConTagZ
         n_data_cons :: ConTagZ
    n_data_cons = TyCon -> ConTagZ
    tyConFamilySize TyCon
    tc
         data_cons :: [DataCon]
    data_cons   = TyCon -> [DataCon]
    tyConDataCons TyCon
    tc

    tx_con_dtt TyCon
    _ AltCon
    alt = String -> SDoc -> Maybe AltCon
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "caseRules/dataToTag: bad alt" (AltCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AltCon
    alt)

    {- Note [caseRules for tagToEnum]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We want to transform
       case tagToEnum# x of
         False -> e1
         True  -> e2
    into
       case x of
         0# -> e1
         1# -> e2

    See #8317.   This rule eliminates a lot of boilerplate. For
      if (x>y) then e2 else e1
    we generate
      case tagToEnum# (x ># y) of
        False -> e1
        True  -> e2
    and it is nice to then get rid of the tagToEnum#.

    Beware (#14768): avoid the temptation to map constructor 0 to
    DEFAULT, in the hope of getting this
      case (x ># y) of
        DEFAULT -> e1
        1#      -> e2
    That fails utterly in the case of
       data Colour = Red | Green | Blue
       case tagToEnum x of
          DEFAULT -> e1
          Red     -> e2

    We don't want to get this!
       case x of
          DEFAULT -> e1
          DEFAULT -> e2

    Instead, when possible, we turn one branch into DEFAULT in
    GHC.Core.Opt.Simplify.Utils.mkCase2; see Note [Literal cases]
    in that module.

    Note [caseRules for dataToTag]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    See also Note [DataToTag overview] in GHC.Tc.Instance.Class.

    We want to transform
      case dataToTagSmall# x of
        DEFAULT -> e1
        1# -> e2
    into
      case x of
        DEFAULT -> e1
        (:) _ _ -> e2

    (Note the need for some wildcard binders in the 'cons' case.)

    This transformation often enables further optimisation via
    case-flattening and case-of-known-constructor and can be very
    important for code using derived Eq instances.

    We can apply this transformation only when we can easily get the
    constructors from the type at which dataToTagSmall# is used.  And we
    cannot apply this transformation at "type data"-related types without
    breaking invariant I1 from Note [Type data declarations] in
    GHC.Rename.Module.  That leaves exactly the types satisfying condition
    DTT2 from Note [DataToTag overview] in GHC.Tc.Instance.Class.

    All of the above applies identically for `dataToTagLarge#`.  And
    thanks to wrinkle DTW5, there is no need to worry about large-tag
    arguments for `dataToTagSmall#`; those cause undefined behavior anyway.

    Note [Unreachable caseRules alternatives]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Take care if we see something like
      case dataToTag x of
        DEFAULT -> e1
        -1# -> e2
        100 -> e3
    because there isn't a data constructor with tag -1 or 100. In this case the
    out-of-range alternative is dead code -- we know the range of tags for x.

    Hence caseRules returns (AltCon -> Maybe AltCon), with Nothing indicating
    an alternative that is unreachable.

    You may wonder how this can happen: check out #15436.
    -}