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

\section[ConFold]{Constant Folder}

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 CPP, RankNTypes, PatternSynonyms, ViewPatterns, RecordWildCards,
    DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE -Wno-incomplete-uni-patterns #-}

module GHC.Core.Opt.ConstantFold
   ( primOpRules
   , builtinRules
   , caseRules
   )
where

#include "HsVersions.h"

import GHC.Prelude

import {-# SOURCE #-} GHC.Types.Id.Make ( mkPrimOpId, magicDictId )

import GHC.Core
import GHC.Core.Make
import GHC.Types.Id
import GHC.Types.Literal
import GHC.Core.SimpleOpt ( exprIsLiteral_maybe )
import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey )
import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Core.TyCon
   ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon
   , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons
   , tyConFamilySize )
import GHC.Core.DataCon ( dataConTagZ, dataConTyCon, dataConWrapId, dataConWorkId )
import GHC.Core.Utils  ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType
                       , stripTicksTop, stripTicksTopT, mkTicks )
import GHC.Core.Unfold ( exprIsConApp_maybe )
import GHC.Core.Type
import GHC.Types.Name.Occurrence ( occNameFS )
import GHC.Builtin.Names
import GHC.Data.Maybe      ( orElse )
import GHC.Types.Name ( Name, nameOccName )
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Types.Basic
import GHC.Platform
import GHC.Utils.Misc
import GHC.Core.Coercion   (mkUnbranchedAxInstCo,mkSymCo,Role(..))

import Control.Applicative ( Alternative(..) )

import Control.Monad
import Data.Bits as Bits
import qualified Data.ByteString as BS
import Data.Int
import Data.Ratio
import Data.Word
import Data.Maybe (fromMaybe)

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

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

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

   -- 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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(+))
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zeroi
                                    , PrimOp -> (Platform -> PrimOps) -> RuleM CoreExpr
numFoldingRules PrimOp
IntAddOp Platform -> PrimOps
intPrimOps
                                    ]
   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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 (-))
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi
                                    , PrimOp -> (Platform -> PrimOps) -> RuleM CoreExpr
numFoldingRules PrimOp
IntSubOp Platform -> PrimOps
intPrimOps
                                    ]
   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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOpC2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(+))
                                    , (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOpC2 (-))
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityCPlatform Platform -> Literal
zeroi
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(*))
                                    , (Platform -> Literal) -> RuleM CoreExpr
zeroElem Platform -> Literal
zeroi
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
onei
                                    , PrimOp -> (Platform -> PrimOps) -> RuleM CoreExpr
numFoldingRules PrimOp
IntMulOp Platform -> PrimOps
intPrimOps
                                    ]
   PrimOp
IntQuotOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
quot)
                                    , (Platform -> Literal) -> RuleM CoreExpr
leftZero Platform -> Literal
zeroi
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
onei
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
onei ]
   PrimOp
IntRemOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
rem)
                                    , (Platform -> Literal) -> RuleM CoreExpr
leftZero Platform -> Literal
zeroi
                                    , do Literal
l <- ConTagZ -> RuleM Literal
getLiteral ConTagZ
1
                                         Platform
platform <- RuleM Platform
getPlatform
                                         Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Literal
l Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Platform -> Literal
onei Platform
platform)
                                         (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi ]
   PrimOp
AndIOp      -> 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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Integer
(.&.))
                                    , RuleM CoreExpr
idempotent
                                    , (Platform -> Literal) -> RuleM CoreExpr
zeroElem Platform -> Literal
zeroi ]
   PrimOp
OrIOp       -> 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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Integer
(.|.))
                                    , RuleM CoreExpr
idempotent
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zeroi ]
   PrimOp
XorIOp      -> 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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Integer
xor)
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zeroi
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi ]
   PrimOp
NotIOp      -> 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
inversePrimOp PrimOp
NotIOp ]
   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
inversePrimOp PrimOp
IntNegOp ]
   PrimOp
ISllOp      -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
External instance of the constraint type Bits Integer
Bits.shiftL)
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi ]
   PrimOp
ISraOp      -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
External instance of the constraint type Bits Integer
Bits.shiftR)
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi ]
   PrimOp
ISrlOp      -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule Platform -> Integer -> ConTagZ -> Integer
shiftRightLogical
                                    , (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(+))
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zerow
                                    , PrimOp -> (Platform -> PrimOps) -> RuleM CoreExpr
numFoldingRules PrimOp
WordAddOp Platform -> PrimOps
wordPrimOps
                                    ]
   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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOp2 (-))
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zerow
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow
                                    , PrimOp -> (Platform -> PrimOps) -> RuleM CoreExpr
numFoldingRules PrimOp
WordSubOp Platform -> PrimOps
wordPrimOps
                                    ]
   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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOpC2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(+))
                                    , (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOpC2 (-))
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityCPlatform Platform -> Literal
zerow
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(*))
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
onew
                                    , PrimOp -> (Platform -> PrimOps) -> RuleM CoreExpr
numFoldingRules PrimOp
WordMulOp Platform -> PrimOps
wordPrimOps
                                    ]
   PrimOp
WordQuotOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
quot)
                                    , (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
onew ]
   PrimOp
WordRemOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
rem)
                                    , (Platform -> Literal) -> RuleM CoreExpr
leftZero Platform -> Literal
zerow
                                    , do Literal
l <- ConTagZ -> RuleM Literal
getLiteral ConTagZ
1
                                         Platform
platform <- RuleM Platform
getPlatform
                                         Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Literal
l Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Platform -> Literal
onew Platform
platform)
                                         (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow ]
   PrimOp
AndOp       -> 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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Integer
(.&.))
                                    , RuleM CoreExpr
idempotent
                                    , (Platform -> Literal) -> RuleM CoreExpr
zeroElem Platform -> Literal
zerow ]
   PrimOp
OrOp        -> 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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Integer
(.|.))
                                    , RuleM CoreExpr
idempotent
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zerow ]
   PrimOp
XorOp       -> 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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
wordOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Integer
xor)
                                    , (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zerow
                                    , RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow ]
   PrimOp
NotOp       -> 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
inversePrimOp PrimOp
NotOp ]
   PrimOp
SllOp       -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
External instance of the constraint type Bits Integer
Bits.shiftL) ]
   PrimOp
SrlOp       -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule Platform -> Integer -> ConTagZ -> Integer
shiftRightLogical ]

   -- coercions
   PrimOp
Word2IntOp     -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
word2IntLit
                                       , PrimOp -> RuleM CoreExpr
inversePrimOp PrimOp
Int2WordOp ]
   PrimOp
Int2WordOp     -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
int2WordLit
                                       , PrimOp -> RuleM CoreExpr
inversePrimOp PrimOp
Word2IntOp ]
   PrimOp
Narrow8IntOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrow8IntLit
                                       , 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
AndIOp PrimOp
Narrow8IntOp ConTagZ
8 ]
   PrimOp
Narrow16IntOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrow16IntLit
                                       , 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
AndIOp PrimOp
Narrow16IntOp ConTagZ
16 ]
   PrimOp
Narrow32IntOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrow32IntLit
                                       , 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
AndIOp PrimOp
Narrow32IntOp ConTagZ
32 ]
   PrimOp
Narrow8WordOp  -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrow8WordLit
                                       , 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
AndOp PrimOp
Narrow8WordOp ConTagZ
8 ]
   PrimOp
Narrow16WordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrow16WordLit
                                       , 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
AndOp PrimOp
Narrow16WordOp ConTagZ
16 ]
   PrimOp
Narrow32WordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrow32WordLit
                                       , 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
AndOp PrimOp
Narrow32WordOp ConTagZ
32 ]
   PrimOp
OrdOp          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
char2IntLit
                                       , PrimOp -> RuleM CoreExpr
inversePrimOp PrimOp
ChrOp ]
   PrimOp
ChrOp          -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ do [Lit Literal
lit] <- RuleM [CoreExpr]
getArgs
                                            Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Literal -> Bool
litFitsInChar Literal
lit)
                                            (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
int2CharLit
                                       , PrimOp -> RuleM CoreExpr
inversePrimOp PrimOp
OrdOp ]
   PrimOp
Float2IntOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
float2IntLit ]
   PrimOp
Int2FloatOp    -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
int2FloatLit ]
   PrimOp
Double2IntOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
double2IntLit ]
   PrimOp
Int2DoubleOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
int2DoubleLit ]
   -- SUP: Not sure what the standard says about precision in the following 2 cases
   PrimOp
Float2DoubleOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
float2DoubleLit ]
   PrimOp
Double2FloatOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
double2FloatLit ]

   -- 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
External instance of the constraint type forall a. Integral a => Num (Ratio a)
External instance of the constraint type Integral Integer
(+))
                                     , 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
External instance of the constraint type forall a. Integral a => Num (Ratio a)
External instance of the constraint type Integral Integer
(*))
                                     , Literal -> RuleM CoreExpr
identity Literal
onef
                                     , Literal -> PrimOp -> RuleM CoreExpr
strengthReduction Literal
twof PrimOp
FloatAddOp  ]
             -- zeroElem zerof doesn't hold because of NaN
   PrimOp
FloatDivOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ RuleM ()
guardFloatDiv RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type forall a. Integral a => Fractional (Ratio a)
External instance of the constraint type Integral Integer
(/))
                                     , 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
inversePrimOp PrimOp
FloatNegOp ]

   -- 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
External instance of the constraint type forall a. Integral a => Num (Ratio a)
External instance of the constraint type Integral Integer
(+))
                                      , 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
External instance of the constraint type forall a. Integral a => Num (Ratio a)
External instance of the constraint type Integral Integer
(*))
                                      , Literal -> RuleM CoreExpr
identity Literal
oned
                                      , Literal -> PrimOp -> RuleM CoreExpr
strengthReduction Literal
twod PrimOp
DoubleAddOp  ]
              -- zeroElem zerod doesn't hold because of NaN
   PrimOp
DoubleDivOp   -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ RuleM ()
guardDoubleDiv RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type forall a. Integral a => Fractional (Ratio a)
External instance of the constraint type Integral Integer
(/))
                                      , 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
inversePrimOp PrimOp
DoubleNegOp ]

   -- Relational operators

   PrimOp
IntEqOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
IntNeOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
   PrimOp
CharEqOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
CharNeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   PrimOp
IntGtOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
IntGeOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
IntLeOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
IntLtOp    -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
CharGtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
CharGeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
CharLeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
CharLtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]

   PrimOp
FloatGtOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>)
   PrimOp
FloatGeOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>=)
   PrimOp
FloatLeOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<=)
   PrimOp
FloatLtOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<)
   PrimOp
FloatEqOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
(==)
   PrimOp
FloatNeOp  -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
(/=)

   PrimOp
DoubleGtOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>)
   PrimOp
DoubleGeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>=)
   PrimOp
DoubleLeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<=)
   PrimOp
DoubleLtOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<)
   PrimOp
DoubleEqOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
(==)
   PrimOp
DoubleNeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
(/=)

   PrimOp
WordGtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
   PrimOp
WordGeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
   PrimOp
WordLeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
   PrimOp
WordLtOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
(<)  [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
   PrimOp
WordEqOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
   PrimOp
WordNeOp   -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]

   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
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
External instance of the constraint type Foldable []
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 forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
cmp RuleM CoreExpr -> [RuleM CoreExpr] -> [RuleM CoreExpr]
forall a. a -> [a] -> [a]
: RuleM CoreExpr
equal_rule RuleM CoreExpr -> [RuleM CoreExpr] -> [RuleM CoreExpr]
forall a. a -> [a] -> [a]
: [RuleM CoreExpr]
extra
  where
        -- x `cmp` x does not depend on x, so
        -- compute it for the arbitrary value 'True'
        -- and use that result
    equal_rule :: RuleM CoreExpr
equal_rule = do { RuleM ()
equalArgs
                    ; Platform
platform <- RuleM Platform
getPlatform
                    ; CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (if Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Bool
cmp Bool
True Bool
True
                              then Platform -> CoreExpr
trueValInt  Platform
platform
                              else Platform -> CoreExpr
falseValInt Platform
platform) }

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

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

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

mkFloatingRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)
                    -> Maybe CoreRule
-- See Note [Rules for floating-point comparisons]
mkFloatingRelOpRule :: Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
cmp
  = Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [(forall a. Ord a => a -> a -> Bool) -> RuleM CoreExpr
binaryCmpLit forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
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

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
External instance of the constraint type Ord Char
`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
External instance of the constraint type forall a. Integral a => Ord (Ratio a)
External instance of the constraint type Integral Integer
`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
External instance of the constraint type forall a. Integral a => Ord (Ratio a)
External instance of the constraint type Integral Integer
`cmp` Rational
i2)
    go (LitNumber LitNumType
nt1 Integer
i1 Kind
_) (LitNumber LitNumType
nt2 Integer
i2 Kind
_)
      | LitNumType
nt1 LitNumType -> LitNumType -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq LitNumType
/= 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
External instance of the constraint type Ord Integer
`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 Kind
t)
      | 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 -> Kind -> Literal
mkLitNumberWrap (RuleOpts -> Platform
roPlatform RuleOpts
env) LitNumType
nt (-Integer
i) Kind
t))
   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 Kind
t) =
   CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> LitNumType -> Integer -> Kind -> Literal
mkLitNumberWrap (RuleOpts -> Platform
roPlatform RuleOpts
env) LitNumType
nt (Integer -> Integer
forall a. Bits a => a -> a
External instance of the constraint type Bits Integer
complement Integer
i) Kind
t))
complementOp RuleOpts
_      Literal
_            = Maybe CoreExpr
forall a. Maybe a
Nothing

--------------------------
intOp2 :: (Integral a, Integral b)
       => (a -> b -> Integer)
       -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 :: (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
Evidence bound by a type signature of the constraint type Integral b
Evidence bound by a type signature of the constraint type Integral a
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' :: (RuleOpts -> a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2' RuleOpts -> a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumInt Integer
i1 Kind
_) (LitNumber LitNumType
LitNumInt Integer
i2 Kind
_) =
  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
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral a
fromInteger Integer
i1 a -> b -> Integer
`o` Integer -> b
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
fromInteger Integer
i2)
intOp2' RuleOpts -> a -> b -> Integer
_  RuleOpts
_      Literal
_            Literal
_            = Maybe CoreExpr
forall a. Maybe a
Nothing  -- Could find LitLit

intOpC2 :: (Integral a, Integral b)
        => (a -> b -> Integer)
        -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 :: (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumInt Integer
i1 Kind
_) (LitNumber LitNumType
LitNumInt Integer
i2 Kind
_) = do
  Platform -> Integer -> Maybe CoreExpr
intCResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
fromInteger Integer
i2)
intOpC2 a -> b -> Integer
_  RuleOpts
_      Literal
_            Literal
_            = Maybe CoreExpr
forall a. Maybe a
Nothing  -- Could find LitLit

shiftRightLogical :: Platform -> Integer -> Int -> Integer
-- Shift right, putting zeros in rather than sign-propagating as Bits.shiftR would do
-- Do this by converting to Word and back.  Obviously this won't work for big
-- values, but its ok as we use it here
shiftRightLogical :: Platform -> Integer -> ConTagZ -> Integer
shiftRightLogical Platform
platform Integer
x ConTagZ
n =
    case Platform -> PlatformWordSize
platformWordSize Platform
platform of
      PlatformWordSize
PW4 -> Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Word32
fromIntegral (Integer -> Word32
forall a. Num a => Integer -> a
External instance of the constraint type Num Word32
fromInteger Integer
x Word32 -> ConTagZ -> Word32
forall a. Bits a => a -> ConTagZ -> a
External instance of the constraint type Bits Word32
`shiftR` ConTagZ
n :: Word32)
      PlatformWordSize
PW8 -> Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Word64
fromIntegral (Integer -> Word64
forall a. Num a => Integer -> a
External instance of the constraint type Num Word64
fromInteger Integer
x Word64 -> ConTagZ -> Word64
forall a. Bits a => a -> ConTagZ -> a
External instance of the constraint type Bits Word64
`shiftR` ConTagZ
n :: Word64)

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

retLitNoC :: (Platform -> Literal) -> RuleM CoreExpr
retLitNoC :: (Platform -> Literal) -> RuleM CoreExpr
retLitNoC Platform -> Literal
l = do Platform
platform <- RuleM Platform
getPlatform
                 let lit :: Literal
lit = Platform -> Literal
l Platform
platform
                 let ty :: Kind
ty = Literal -> Kind
literalType Literal
lit
                 CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [Kind] -> [CoreExpr] -> CoreExpr
mkCoreUbxTup [Kind
ty, Kind
ty] [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit, Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)]

wordOp2 :: (Integral a, Integral b)
        => (a -> b -> Integer)
        -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 :: (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumWord Integer
w1 Kind
_) (LitNumber LitNumType
LitNumWord Integer
w2 Kind
_)
    = Platform -> Integer -> Maybe CoreExpr
wordResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral a
fromInteger Integer
w1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
fromInteger Integer
w2)
wordOp2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing  -- Could find LitLit

wordOpC2 :: (Integral a, Integral b)
        => (a -> b -> Integer)
        -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 :: (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumWord Integer
w1 Kind
_) (LitNumber LitNumType
LitNumWord Integer
w2 Kind
_) =
  Platform -> Integer -> Maybe CoreExpr
wordCResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral a
fromInteger Integer
w1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
fromInteger Integer
w2)
wordOpC2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing  -- Could find LitLit

shiftRule :: (Platform -> Integer -> Int -> Integer) -> RuleM CoreExpr
-- Shifts take an Int; hence third arg of op is Int
-- Used for shift primops
--    ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word#
--    SllOp, SrlOp           :: Word# -> Int# -> Word#
shiftRule :: (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule Platform -> Integer -> ConTagZ -> Integer
shift_op
  = do { Platform
platform <- RuleM Platform
getPlatform
       ; [CoreExpr
e1, Lit (LitNumber LitNumType
LitNumInt Integer
shift_len Kind
_)] <- RuleM [CoreExpr]
getArgs
       ; case CoreExpr
e1 of
           CoreExpr
_ | Integer
shift_len Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
0
             -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return CoreExpr
e1
             -- See Note [Guarding against silly shifts]
             | Integer
shift_len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
< Integer
0 Bool -> Bool -> Bool
|| Integer
shift_len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
> ConTagZ -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral ConTagZ
toInteger (Platform -> ConTagZ
platformWordSizeInBits Platform
platform)
             -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> LitNumType -> Integer -> Kind -> Literal
mkLitNumberWrap Platform
platform LitNumType
LitNumInt Integer
0 (CoreExpr -> Kind
exprType CoreExpr
e1)

           -- Do the shift at type Integer, but shift length is Int
           Lit (LitNumber LitNumType
nt Integer
x Kind
t)
             | Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
< Integer
shift_len
             , Integer
shift_len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
<= ConTagZ -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral ConTagZ
toInteger (Platform -> ConTagZ
platformWordSizeInBits Platform
platform)
             -> let op :: Integer -> ConTagZ -> Integer
op = Platform -> Integer -> ConTagZ -> Integer
shift_op Platform
platform
                    y :: Integer
y  = Integer
x Integer -> ConTagZ -> Integer
`op` Integer -> ConTagZ
forall a. Num a => Integer -> a
External instance of the constraint type Num ConTagZ
fromInteger Integer
shift_len
                in  Maybe CoreExpr -> RuleM CoreExpr
forall a. Maybe a -> RuleM a
liftMaybe (Maybe CoreExpr -> RuleM CoreExpr)
-> Maybe CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> LitNumType -> Integer -> Kind -> Literal
mkLitNumberWrap Platform
platform LitNumType
nt Integer
y Kind
t))

           CoreExpr
_ -> RuleM CoreExpr
forall (m :: * -> *) a. MonadPlus m => m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
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

--------------------------
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

--------------------------
{- 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
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
External instance of the constraint type Foldable []
msum
  [ do [Lit Literal
lit, CoreExpr
expr] <- RuleM [CoreExpr]
getArgs
       Platform
platform <- RuleM Platform
getPlatform
       Platform -> Literal -> CoreExpr -> RuleM CoreExpr
forall {m :: * -> *}.
(Monad m, Alternative m) =>
Platform -> Literal -> CoreExpr -> m CoreExpr
Instance of class: Alternative of the constraint type Alternative RuleM
Instance of class: Monad of the constraint type Monad RuleM
do_lit_eq Platform
platform Literal
lit CoreExpr
expr
  , do [CoreExpr
expr, Lit Literal
lit] <- RuleM [CoreExpr]
getArgs
       Platform
platform <- RuleM Platform
getPlatform
       Platform -> Literal -> CoreExpr -> RuleM CoreExpr
forall {m :: * -> *}.
(Monad m, Alternative m) =>
Platform -> Literal -> CoreExpr -> m CoreExpr
Instance of class: Alternative of the constraint type Alternative RuleM
Instance of class: Monad of the constraint type Monad RuleM
do_lit_eq Platform
platform Literal
lit CoreExpr
expr ]
  where
    do_lit_eq :: Platform -> Literal -> CoreExpr -> m CoreExpr
do_lit_eq Platform
platform Literal
lit CoreExpr
expr = do
      Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Evidence bound by a type signature of the constraint type Alternative m
guard (Bool -> Bool
not (Literal -> Bool
litIsLifted Literal
lit))
      CoreExpr -> m CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Evidence bound by a type signature of the constraint type Monad m
return (CoreExpr -> Kind -> Kind -> [CoreAlt] -> CoreExpr
mkWildCase CoreExpr
expr (Literal -> Kind
literalType Literal
lit) Kind
intPrimTy
                    [(AltCon
DEFAULT,    [], CoreExpr
val_if_neq),
                     (Literal -> AltCon
LitAlt Literal
lit, [], CoreExpr
val_if_eq)])
      where
        val_if_eq :: CoreExpr
val_if_eq  | Bool
is_eq     = Platform -> CoreExpr
trueValInt  Platform
platform
                   | Bool
otherwise = Platform -> CoreExpr
falseValInt Platform
platform
        val_if_neq :: CoreExpr
val_if_neq | Bool
is_eq     = Platform -> CoreExpr
falseValInt Platform
platform
                   | Bool
otherwise = Platform -> CoreExpr
trueValInt  Platform
platform


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

data Comparison = Gt | Ge | Lt | Le

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

isMinBound :: Platform -> Literal -> Bool
isMinBound :: Platform -> Literal -> Bool
isMinBound Platform
_        (LitChar Char
c)        = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
forall a. Bounded a => a
External instance of the constraint type Bounded Char
minBound
isMinBound Platform
platform (LitNumber LitNumType
nt Integer
i Kind
_) = case LitNumType
nt of
   LitNumType
LitNumInt     -> Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Platform -> Integer
platformMinInt Platform
platform
   LitNumType
LitNumInt64   -> Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Int64 -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Int64
toInteger (Int64
forall a. Bounded a => a
External instance of the constraint type Bounded Int64
minBound :: Int64)
   LitNumType
LitNumWord    -> Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
0
   LitNumType
LitNumWord64  -> Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
0
   LitNumType
LitNumNatural -> Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
0
   LitNumType
LitNumInteger -> Bool
False
isMinBound Platform
_        Literal
_                  = Bool
False

isMaxBound :: Platform -> Literal -> Bool
isMaxBound :: Platform -> Literal -> Bool
isMaxBound Platform
_        (LitChar Char
c)        = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
forall a. Bounded a => a
External instance of the constraint type Bounded Char
maxBound
isMaxBound Platform
platform (LitNumber LitNumType
nt Integer
i Kind
_) = case LitNumType
nt of
   LitNumType
LitNumInt     -> Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Platform -> Integer
platformMaxInt Platform
platform
   LitNumType
LitNumInt64   -> Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Int64 -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Int64
toInteger (Int64
forall a. Bounded a => a
External instance of the constraint type Bounded Int64
maxBound :: Int64)
   LitNumType
LitNumWord    -> Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Platform -> Integer
platformMaxWord Platform
platform
   LitNumType
LitNumWord64  -> Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Word64 -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Word64
toInteger (Word64
forall a. Bounded a => a
External instance of the constraint type Bounded Word64
maxBound :: Word64)
   LitNumType
LitNumNatural -> Bool
False
   LitNumType
LitNumInteger -> Bool
False
isMaxBound Platform
_        Literal
_                  = Bool
False

-- | Create an Int literal expression while ensuring the given Integer is in the
-- target Int range
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
mkPair [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit, Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
c])
  where
    mkPair :: [CoreExpr] -> CoreExpr
mkPair = [Kind] -> [CoreExpr] -> CoreExpr
mkCoreUbxTup [Kind
intPrimTy, Kind
intPrimTy]
    (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
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
mkPair [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit, Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
c])
  where
    mkPair :: [CoreExpr] -> CoreExpr
mkPair = [Kind] -> [CoreExpr] -> CoreExpr
mkCoreUbxTup [Kind
wordPrimTy, Kind
intPrimTy]
    (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

inversePrimOp :: PrimOp -> RuleM CoreExpr
inversePrimOp :: PrimOp -> RuleM CoreExpr
inversePrimOp PrimOp
primop = do
  [Var Id
primop_id `App` CoreExpr
e] <- RuleM [CoreExpr]
getArgs
  PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
primop Id
primop_id
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return CoreExpr
e

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

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

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

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

{-
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/app
invariant (see Note [Core let/app invariant] in GHC.Core) as noted in #16742.
For the reasons discussed in Note [Checking versus non-checking primops] (in
the PrimOp module) there is no safe way rewrite the argument of I# such that
it bottoms.

Consequently we instead take advantage of the fact that large shifts are
undefined behavior (see associated documentation in primops.txt.pp) and
transform the invalid shift into an "obviously incorrect" value.

There are two cases:

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

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

- Shifting Integers: the function shiftLInteger, shiftRInteger
  from the 'integer' library.   These are handled by rule_shift_op,
  and match_Integer_shift_op.

  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 :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
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
  { RuleM r -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r
runRuleM :: RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r }
  deriving (a -> RuleM b -> RuleM a
(a -> b) -> RuleM a -> RuleM b
(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
<$ :: a -> RuleM b -> RuleM a
$c<$ :: forall a b. a -> RuleM b -> RuleM a
fmap :: (a -> b) -> RuleM a -> RuleM b
$cfmap :: forall a b. (a -> b) -> RuleM a -> RuleM b
External instance of the constraint type Functor Maybe
Functor)

instance Applicative RuleM where
    pure :: 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
    <*> :: 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
Instance of class: Monad of the constraint type Monad RuleM
ap

instance Monad RuleM where
  RuleM RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
f >>= :: 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 :: String -> RuleM a
fail String
_ = RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
mzero

instance Alternative RuleM where
  empty :: 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 <|> :: 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
External instance of the constraint type Alternative Maybe
<|> 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
Instance of class: Functor of the constraint type Functor RuleM
<$> RuleM RuleOpts
getEnv

getEnv :: RuleM RuleOpts
getEnv :: RuleM RuleOpts
getEnv = (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
env InScopeEnv
_ Id
_ [CoreExpr]
_ -> RuleOpts -> Maybe RuleOpts
forall a. a -> Maybe a
Just RuleOpts
env

liftMaybe :: Maybe a -> RuleM a
liftMaybe :: Maybe a -> RuleM a
liftMaybe Maybe a
Nothing = RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
mzero
liftMaybe (Just a
x) = a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
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
platform <- RuleM Platform
getPlatform
  [Lit Literal
lit] <- RuleM [CoreExpr]
getArgs
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal -> Literal
f Platform
platform Literal
lit)

removeOp32 :: RuleM CoreExpr
removeOp32 :: RuleM CoreExpr
removeOp32 = do
  Platform
platform <- RuleM Platform
getPlatform
  case Platform -> PlatformWordSize
platformWordSize Platform
platform of
    PlatformWordSize
PW4 -> do
      [CoreExpr
e] <- RuleM [CoreExpr]
getArgs
      CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return CoreExpr
e
    PlatformWordSize
PW8 ->
      RuleM CoreExpr
forall (m :: * -> *) a. MonadPlus m => m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
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

-- 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
  RuleOpts
env <- RuleM RuleOpts
getEnv
  [Lit Literal
l] <- RuleM [CoreExpr]
getArgs
  Maybe CoreExpr -> RuleM CoreExpr
forall a. Maybe a -> RuleM a
liftMaybe (Maybe CoreExpr -> RuleM CoreExpr)
-> Maybe CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ RuleOpts -> Literal -> Maybe CoreExpr
op RuleOpts
env (RuleOpts -> Literal -> Literal
convFloating RuleOpts
env Literal
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
  RuleOpts
env <- RuleM RuleOpts
getEnv
  [Lit Literal
l1, Lit Literal
l2] <- RuleM [CoreExpr]
getArgs
  Maybe CoreExpr -> RuleM CoreExpr
forall a. Maybe a -> RuleM a
liftMaybe (Maybe CoreExpr -> RuleM CoreExpr)
-> Maybe CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ RuleOpts -> Literal -> Literal -> Maybe CoreExpr
op RuleOpts
env (RuleOpts -> Literal -> Literal
convFloating RuleOpts
env Literal
l1) (RuleOpts -> Literal -> Literal
convFloating RuleOpts
env Literal
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
platform <- RuleM Platform
getPlatform
  (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit (\RuleOpts
_ -> Platform
-> (forall a. Ord a => a -> a -> Bool)
-> Literal
-> Literal
-> Maybe CoreExpr
cmpOp Platform
platform forall a. Ord a => a -> a -> Bool
Evidence bound by a HsWrapper of the constraint type Ord a
Evidence bound by a HsWrapper of the constraint type Ord a
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 (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
`mplus` Literal -> RuleM CoreExpr
rightIdentity Literal
lit

leftIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
leftIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
leftIdentityPlatform Platform -> Literal
id_lit = do
  Platform
platform <- RuleM Platform
getPlatform
  [Lit Literal
l1, CoreExpr
e2] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l1 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Platform -> Literal
id_lit Platform
platform
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return CoreExpr
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
platform <- RuleM Platform
getPlatform
  [Lit Literal
l1, CoreExpr
e2] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l1 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Platform -> Literal
id_lit Platform
platform
  let no_c :: Expr b
no_c = Literal -> Expr b
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return ([Kind] -> [CoreExpr] -> CoreExpr
mkCoreUbxTup [CoreExpr -> Kind
exprType CoreExpr
e2, Kind
intPrimTy] [CoreExpr
e2, CoreExpr
forall {b}. Expr b
no_c])

rightIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
id_lit = do
  Platform
platform <- RuleM Platform
getPlatform
  [CoreExpr
e1, Lit Literal
l2] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l2 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Platform -> Literal
id_lit Platform
platform
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return CoreExpr
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
platform <- RuleM Platform
getPlatform
  [CoreExpr
e1, Lit Literal
l2] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l2 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Platform -> Literal
id_lit Platform
platform
  let no_c :: Expr b
no_c = Literal -> Expr b
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return ([Kind] -> [CoreExpr] -> CoreExpr
mkCoreUbxTup [CoreExpr -> Kind
exprType CoreExpr
e1, Kind
intPrimTy] [CoreExpr
e1, CoreExpr
forall {b}. Expr b
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 (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
`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 (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
`mplus` (Platform -> Literal) -> RuleM CoreExpr
rightIdentityCPlatform Platform -> Literal
lit

leftZero :: (Platform -> Literal) -> RuleM CoreExpr
leftZero :: (Platform -> Literal) -> RuleM CoreExpr
leftZero Platform -> Literal
zero = do
  Platform
platform <- RuleM Platform
getPlatform
  [Lit Literal
l1, CoreExpr
_] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l1 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Platform -> Literal
zero Platform
platform
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
l1

rightZero :: (Platform -> Literal) -> RuleM CoreExpr
rightZero :: (Platform -> Literal) -> RuleM CoreExpr
rightZero Platform -> Literal
zero = do
  Platform
platform <- RuleM Platform
getPlatform
  [CoreExpr
_, Lit Literal
l2] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l2 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Platform -> Literal
zero Platform
platform
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
l2

zeroElem :: (Platform -> Literal) -> RuleM CoreExpr
zeroElem :: (Platform -> Literal) -> RuleM CoreExpr
zeroElem Platform -> Literal
lit = (Platform -> Literal) -> RuleM CoreExpr
leftZero Platform -> Literal
lit RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
`mplus` (Platform -> Literal) -> RuleM CoreExpr
rightZero Platform -> Literal
lit

equalArgs :: RuleM ()
equalArgs :: RuleM ()
equalArgs = do
  [CoreExpr
e1, CoreExpr
e2] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ CoreExpr
e1 CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
e2

nonZeroLit :: Int -> RuleM ()
nonZeroLit :: ConTagZ -> RuleM ()
nonZeroLit ConTagZ
n = ConTagZ -> RuleM Literal
getLiteral ConTagZ
n RuleM Literal -> (Literal -> RuleM ()) -> RuleM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Instance of class: Monad of the constraint type Monad RuleM
>>= Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
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

-- 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
External instance of the constraint type Real Float
toRational (Rational -> Float
forall a. Fractional a => Rational -> a
External instance of the constraint type Fractional Float
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
External instance of the constraint type Real Double
toRational (Rational -> Double
forall a. Fractional a => Rational -> a
External instance of the constraint type Fractional Double
fromRational Rational
d :: Double))
convFloating RuleOpts
_ Literal
l = Literal
l

guardFloatDiv :: RuleM ()
guardFloatDiv :: RuleM ()
guardFloatDiv = do
  [Lit (LitFloat Rational
f1), Lit (LitFloat Rational
f2)] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ (Rational
f1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq (Ratio a)
External instance of the constraint type Eq Integer
/=Rational
0 Bool -> Bool -> Bool
|| Rational
f2 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Integral a => Ord (Ratio a)
External instance of the constraint type Integral Integer
> Rational
0) -- see Note [negative zero]
       Bool -> Bool -> Bool
&& Rational
f2 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq (Ratio a)
External instance of the constraint type Eq Integer
/= Rational
0            -- avoid NaN and Infinity/-Infinity

guardDoubleDiv :: RuleM ()
guardDoubleDiv :: RuleM ()
guardDoubleDiv = do
  [Lit (LitDouble Rational
d1), Lit (LitDouble Rational
d2)] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ (Rational
d1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq (Ratio a)
External instance of the constraint type Eq Integer
/=Rational
0 Bool -> Bool -> Bool
|| Rational
d2 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Integral a => Ord (Ratio a)
External instance of the constraint type Integral Integer
> Rational
0) -- see Note [negative zero]
       Bool -> Bool -> Bool
&& Rational
d2 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq (Ratio a)
External instance of the constraint type Eq Integer
/= Rational
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]
  CoreExpr
arg <- [RuleM CoreExpr] -> RuleM CoreExpr
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
External instance of the constraint type Foldable []
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
msum [ do [CoreExpr
arg, Lit Literal
mult_lit] <- RuleM [CoreExpr]
getArgs
                   Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Literal
mult_lit Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Literal
two_lit)
                   CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return CoreExpr
arg
              , do [Lit Literal
mult_lit, CoreExpr
arg] <- RuleM [CoreExpr]
getArgs
                   Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Literal
mult_lit Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Literal
== Literal
two_lit)
                   CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return CoreExpr
arg ]
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
mkPrimOpId PrimOp
add_op) CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
arg CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
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
  PrimOp
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
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ PrimOp
op PrimOp -> PrimOp -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq PrimOp
== PrimOp
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 Kind
ty, Lit (LitNumber LitNumType
LitNumInt Integer
i Kind
_)] <- RuleM [CoreExpr]
getArgs
  case HasDebugCallStack => Kind -> Maybe (TyCon, [Kind])
Kind -> Maybe (TyCon, [Kind])
External instance of the constraint type HasDebugCallStack
splitTyConApp_maybe Kind
ty of
    Just (TyCon
tycon, [Kind]
tc_args) | TyCon -> Bool
isEnumerationTyCon TyCon
tycon -> do
      let tag :: ConTagZ
tag = Integer -> ConTagZ
forall a. Num a => Integer -> a
External instance of the constraint type Num ConTagZ
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
External instance of the constraint type Eq ConTagZ
== ConTagZ
tag
      (DataCon
dc:[DataCon]
rest) <- [DataCon] -> RuleM [DataCon]
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
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` [])
      ASSERT(null rest) return ()
      CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ CoreExpr -> [Kind] -> CoreExpr
forall b. Expr b -> [Kind] -> Expr b
mkTyApps (Id -> CoreExpr
forall b. Id -> Expr b
Var (DataCon -> Id
dataConWorkId DataCon
dc)) [Kind]
tc_args

    -- See Note [tagToEnum#]
    Maybe (TyCon, [Kind])
_ -> WARN( True, text "tagToEnum# on non-enumeration type" <+> ppr ty )
         CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> Kind -> String -> CoreExpr
mkRuntimeErrorApp Id
rUNTIME_ERROR_ID Kind
ty String
"tagToEnum# on non-enumeration type"

------------------------------
dataToTagRule :: RuleM CoreExpr
-- See Note [dataToTag#] in primops.txt.pp
dataToTagRule :: RuleM CoreExpr
dataToTagRule = RuleM CoreExpr
a RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
`mplus` RuleM CoreExpr
b
  where
    -- dataToTag (tagToEnum x)   ==>   x
    a :: RuleM CoreExpr
a = do
      [Type Kind
ty1, Var Id
tag_to_enum `App` Type Kind
ty2 `App` CoreExpr
tag] <- RuleM [CoreExpr]
getArgs
      Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Id
tag_to_enum Id -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
External instance of the constraint type Uniquable Id
`hasKey` Unique
tagToEnumKey
      Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Kind
ty1 Kind -> Kind -> Bool
`eqType` Kind
ty2
      CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return CoreExpr
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
dflags <- RuleM Platform
getPlatform
      [CoreExpr
_, CoreExpr
val_arg] <- RuleM [CoreExpr]
getArgs
      InScopeEnv
in_scope <- RuleM InScopeEnv
getInScopeEnv
      (InScopeSet
_,[FloatBind]
floats, DataCon
dc,[Kind]
_,[CoreExpr]
_) <- Maybe (InScopeSet, [FloatBind], DataCon, [Kind], [CoreExpr])
-> RuleM (InScopeSet, [FloatBind], DataCon, [Kind], [CoreExpr])
forall a. Maybe a -> RuleM a
liftMaybe (Maybe (InScopeSet, [FloatBind], DataCon, [Kind], [CoreExpr])
 -> RuleM (InScopeSet, [FloatBind], DataCon, [Kind], [CoreExpr]))
-> Maybe (InScopeSet, [FloatBind], DataCon, [Kind], [CoreExpr])
-> RuleM (InScopeSet, [FloatBind], DataCon, [Kind], [CoreExpr])
forall a b. (a -> b) -> a -> b
$ InScopeEnv
-> CoreExpr
-> Maybe (InScopeSet, [FloatBind], DataCon, [Kind], [CoreExpr])
exprIsConApp_maybe InScopeEnv
in_scope CoreExpr
val_arg
      ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return ()
      CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [FloatBind] -> CoreExpr -> CoreExpr
wrapFloats [FloatBind]
floats (Platform -> Integer -> CoreExpr
mkIntVal Platform
dflags (ConTagZ -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral ConTagZ
toInteger (DataCon -> ConTagZ
dataConTagZ DataCon
dc)))

{- Note [dataToTag# magic]
~~~~~~~~~~~~~~~~~~~~~~~~~~
The primop dataToTag# is unusual because it evaluates its argument.
Only `SeqOp` shares that property.  (Other primops do not do anything
as fancy as argument evaluation.)  The special handling for dataToTag#
is:

* GHC.Core.Utils.exprOkForSpeculation has a special case for DataToTagOp,
  (actually in app_ok).  Most primops with lifted arguments do not
  evaluate those arguments, but DataToTagOp and SeqOp are two
  exceptions.  We say that they are /never/ ok-for-speculation,
  regardless of the evaluated-ness of their argument.
  See GHC.Core.Utils Note [exprOkForSpeculation and SeqOp/DataToTagOp]

* There is a special case for DataToTagOp in GHC.StgToCmm.Expr.cgExpr,
  that evaluates its argument and then extracts the tag from
  the returned value.

* An application like (dataToTag# (Just x)) is optimised by
  dataToTagRule in GHC.Core.Opt.ConstantFold.

* A case expression like
     case (dataToTag# e) of <alts>
  gets transformed t
     case e of <transformed alts>
  by GHC.Core.Opt.ConstantFold.caseRules; see Note [caseRules for dataToTag]

See #15696 for a long saga.
-}

{- *********************************************************************
*                                                                      *
             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 Kind
rep, Type Kind
t1, Type Kind
t2] <- RuleM [CoreExpr]
getArgs
       ; Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Kind
t1 Kind -> Kind -> Bool
`eqType` Kind
t2)
       ; Id
fn <- RuleM Id
getFunction
       ; let ([Id]
_, Kind
ue) = Kind -> ([Id], Kind)
splitForAllTys (Id -> Kind
idType Id
fn)
             tc :: TyCon
tc      = Kind -> TyCon
tyConAppTyCon Kind
ue  -- tycon:    UnsafeEquality
             (DataCon
dc:[DataCon]
_)  = TyCon -> [DataCon]
tyConDataCons TyCon
tc  -- data con: UnsafeRefl
             -- UnsafeRefl :: forall (r :: RuntimeRep) (a :: TYPE r).
             --               UnsafeEquality r a a
       ; CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> [Kind] -> CoreExpr
forall b. Expr b -> [Kind] -> Expr b
mkTyApps (Id -> CoreExpr
forall b. Id -> Expr b
Var (DataCon -> Id
dataConWrapId DataCon
dc)) [Kind
rep, Kind
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#

- GHC.Core.Utils.exprOkForSpeculation;
  see Note [exprOkForSpeculation and SeqOp/DataToTagOp] in GHC.Core.Utils

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

seqRule :: RuleM CoreExpr
seqRule :: RuleM CoreExpr
seqRule = do
  [Type Kind
ty_a, Type Kind
_ty_s, CoreExpr
a, CoreExpr
s] <- RuleM [CoreExpr]
getArgs
  Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Instance of class: Alternative of the constraint type Alternative RuleM
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ CoreExpr -> Bool
exprIsHNF CoreExpr
a
  CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [Kind] -> [CoreExpr] -> CoreExpr
mkCoreUbxTup [CoreExpr -> Kind
exprType CoreExpr
s, Kind
ty_a] [CoreExpr
s, CoreExpr
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 :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
"AppendLitString",
                   ru_fn :: Name
ru_fn = Name
unpackCStringFoldrName,
                   ru_nargs :: ConTagZ
ru_nargs = ConTagZ
4, ru_try :: RuleFun
ru_try = RuleFun
match_append_lit },
     BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
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 :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
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 :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
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 },
     BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
"MagicDict", ru_fn :: Name
ru_fn = Id -> Name
idName Id
magicDictId,
                   ru_nargs :: ConTagZ
ru_nargs = ConTagZ
4, ru_try :: RuleFun
ru_try = \RuleOpts
_ InScopeEnv
_ Id
_ -> [CoreExpr] -> Maybe CoreExpr
match_magicDict },

     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
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
External instance of the constraint type Foldable []
msum
        [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
div)
        , (Platform -> Literal) -> RuleM CoreExpr
leftZero Platform -> Literal
zeroi
        , do
          [CoreExpr
arg, Lit (LitNumber LitNumType
LitNumInt Integer
d Kind
_)] <- RuleM [CoreExpr]
getArgs
          Just Integer
n <- Maybe Integer -> RuleM (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (Maybe Integer -> RuleM (Maybe Integer))
-> Maybe Integer -> RuleM (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe Integer
exactLog2 Integer
d
          Platform
platform <- RuleM Platform
getPlatform
          CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
mkPrimOpId PrimOp
ISraOp) CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
arg CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` Platform -> Integer -> CoreExpr
mkIntVal Platform
platform Integer
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
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
External instance of the constraint type Foldable []
msum
        [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Instance of class: Monad of the constraint type Monad RuleM
>> (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
External instance of the constraint type Integral Integer
External instance of the constraint type Integral Integer
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
mod)
        , (Platform -> Literal) -> RuleM CoreExpr
leftZero Platform -> Literal
zeroi
        , do
          [CoreExpr
arg, Lit (LitNumber LitNumType
LitNumInt Integer
d Kind
_)] <- RuleM [CoreExpr]
getArgs
          Just Integer
_ <- Maybe Integer -> RuleM (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (Maybe Integer -> RuleM (Maybe Integer))
-> Maybe Integer -> RuleM (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe Integer
exactLog2 Integer
d
          Platform
platform <- RuleM Platform
getPlatform
          CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
mkPrimOpId PrimOp
AndIOp)
            CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
arg CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` Platform -> Integer -> CoreExpr
mkIntVal Platform
platform (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
- Integer
1)
        ]
     ]
 [CoreRule] -> [CoreRule] -> [CoreRule]
forall a. [a] -> [a] -> [a]
++ [CoreRule]
builtinIntegerRules
 [CoreRule] -> [CoreRule] -> [CoreRule]
forall a. [a] -> [a] -> [a]
++ [CoreRule]
builtinNaturalRules
{-# 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.

builtinIntegerRules :: [CoreRule]
builtinIntegerRules :: [CoreRule]
builtinIntegerRules =
 [String -> Name -> CoreRule
rule_IntToInteger   String
"smallInteger"        Name
smallIntegerName,
  String -> Name -> CoreRule
rule_WordToInteger  String
"wordToInteger"       Name
wordToIntegerName,
  String -> Name -> CoreRule
rule_Int64ToInteger  String
"int64ToInteger"     Name
int64ToIntegerName,
  String -> Name -> CoreRule
rule_Word64ToInteger String
"word64ToInteger"    Name
word64ToIntegerName,
  String -> Name -> (Platform -> Word -> CoreExpr) -> CoreRule
forall {a}.
Num a =>
String -> Name -> (Platform -> a -> CoreExpr) -> CoreRule
External instance of the constraint type Num Word
rule_convert        String
"integerToWord"       Name
integerToWordName       Platform -> Word -> CoreExpr
forall b. Platform -> Word -> Expr b
mkWordLitWord,
  String -> Name -> (Platform -> ConTagZ -> CoreExpr) -> CoreRule
forall {a}.
Num a =>
String -> Name -> (Platform -> a -> CoreExpr) -> CoreRule
External instance of the constraint type Num ConTagZ
rule_convert        String
"integerToInt"        Name
integerToIntName        Platform -> ConTagZ -> CoreExpr
forall b. Platform -> ConTagZ -> Expr b
mkIntLitInt,
  String -> Name -> (Platform -> Word64 -> CoreExpr) -> CoreRule
forall {a}.
Num a =>
String -> Name -> (Platform -> a -> CoreExpr) -> CoreRule
External instance of the constraint type Num Word64
rule_convert        String
"integerToWord64"     Name
integerToWord64Name     (\Platform
_ -> Word64 -> CoreExpr
forall b. Word64 -> Expr b
mkWord64LitWord64),
  String -> Name -> (Platform -> Int64 -> CoreExpr) -> CoreRule
forall {a}.
Num a =>
String -> Name -> (Platform -> a -> CoreExpr) -> CoreRule
External instance of the constraint type Num Int64
rule_convert        String
"integerToInt64"      Name
integerToInt64Name      (\Platform
_ -> Int64 -> CoreExpr
forall b. Int64 -> Expr b
mkInt64LitInt64),
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop          String
"plusInteger"         Name
plusIntegerName         Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(+),
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop          String
"minusInteger"        Name
minusIntegerName        (-),
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop          String
"timesInteger"        Name
timesIntegerName        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(*),
  String -> Name -> (Integer -> Integer) -> CoreRule
rule_unop           String
"negateInteger"       Name
negateIntegerName       Integer -> Integer
forall a. Num a => a -> a
External instance of the constraint type Num Integer
negate,
  String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
rule_binop_Prim     String
"eqInteger#"          Name
eqIntegerPrimName       Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
(==),
  String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
rule_binop_Prim     String
"neqInteger#"         Name
neqIntegerPrimName      Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
(/=),
  String -> Name -> (Integer -> Integer) -> CoreRule
rule_unop           String
"absInteger"          Name
absIntegerName          Integer -> Integer
forall a. Num a => a -> a
External instance of the constraint type Num Integer
abs,
  String -> Name -> (Integer -> Integer) -> CoreRule
rule_unop           String
"signumInteger"       Name
signumIntegerName       Integer -> Integer
forall a. Num a => a -> a
External instance of the constraint type Num Integer
signum,
  String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
rule_binop_Prim     String
"leInteger#"          Name
leIntegerPrimName       Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
(<=),
  String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
rule_binop_Prim     String
"gtInteger#"          Name
gtIntegerPrimName       Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
(>),
  String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
rule_binop_Prim     String
"ltInteger#"          Name
ltIntegerPrimName       Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
(<),
  String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
rule_binop_Prim     String
"geInteger#"          Name
geIntegerPrimName       Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
(>=),
  String -> Name -> (Integer -> Integer -> Ordering) -> CoreRule
rule_binop_Ordering String
"compareInteger"      Name
compareIntegerName      Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord Integer
compare,
  String -> Name -> (Float -> CoreExpr) -> CoreRule
forall {a}.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
External instance of the constraint type RealFloat Float
rule_encodeFloat    String
"encodeFloatInteger"  Name
encodeFloatIntegerName  Float -> CoreExpr
forall b. Float -> Expr b
mkFloatLitFloat,
  String -> Name -> (Platform -> Float -> CoreExpr) -> CoreRule
forall {a}.
Num a =>
String -> Name -> (Platform -> a -> CoreExpr) -> CoreRule
External instance of the constraint type Num Float
rule_convert        String
"floatFromInteger"    Name
floatFromIntegerName    (\Platform
_ -> Float -> CoreExpr
forall b. Float -> Expr b
mkFloatLitFloat),
  String -> Name -> (Double -> CoreExpr) -> CoreRule
forall {a}.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
External instance of the constraint type RealFloat Double
rule_encodeFloat    String
"encodeDoubleInteger" Name
encodeDoubleIntegerName Double -> CoreExpr
forall b. Double -> Expr b
mkDoubleLitDouble,
  String -> Name -> CoreRule
rule_decodeDouble   String
"decodeDoubleInteger" Name
decodeDoubleIntegerName,
  String -> Name -> (Platform -> Double -> CoreExpr) -> CoreRule
forall {a}.
Num a =>
String -> Name -> (Platform -> a -> CoreExpr) -> CoreRule
External instance of the constraint type Num Double
rule_convert        String
"doubleFromInteger"   Name
doubleFromIntegerName   (\Platform
_ -> Double -> CoreExpr
forall b. Double -> Expr b
mkDoubleLitDouble),
  String -> Name -> (Float -> CoreExpr) -> CoreRule
forall {a}.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
External instance of the constraint type RealFloat Float
rule_rationalTo     String
"rationalToFloat"     Name
rationalToFloatName     Float -> CoreExpr
mkFloatExpr,
  String -> Name -> (Double -> CoreExpr) -> CoreRule
forall {a}.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
External instance of the constraint type RealFloat Double
rule_rationalTo     String
"rationalToDouble"    Name
rationalToDoubleName    Double -> CoreExpr
mkDoubleExpr,
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop          String
"gcdInteger"          Name
gcdIntegerName          Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
gcd,
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop          String
"lcmInteger"          Name
lcmIntegerName          Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
lcm,
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop          String
"andInteger"          Name
andIntegerName          Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Integer
(.&.),
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop          String
"orInteger"           Name
orIntegerName           Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Integer
(.|.),
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop          String
"xorInteger"          Name
xorIntegerName          Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Integer
xor,
  String -> Name -> (Integer -> Integer) -> CoreRule
rule_unop           String
"complementInteger"   Name
complementIntegerName   Integer -> Integer
forall a. Bits a => a -> a
External instance of the constraint type Bits Integer
complement,
  String -> Name -> (Integer -> ConTagZ -> Integer) -> CoreRule
rule_shift_op       String
"shiftLInteger"       Name
shiftLIntegerName       Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
External instance of the constraint type Bits Integer
shiftL,
  String -> Name -> (Integer -> ConTagZ -> Integer) -> CoreRule
rule_shift_op       String
"shiftRInteger"       Name
shiftRIntegerName       Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
External instance of the constraint type Bits Integer
shiftR,
  String -> Name -> CoreRule
rule_bitInteger     String
"bitInteger"          Name
bitIntegerName,
  -- See Note [Integer division constant folding] in libraries/base/GHC/Real.hs
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_divop_one      String
"quotInteger"         Name
quotIntegerName         Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
quot,
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_divop_one      String
"remInteger"          Name
remIntegerName          Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
rem,
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_divop_one      String
"divInteger"          Name
divIntegerName          Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
div,
  String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_divop_one      String
"modInteger"          Name
modIntegerName          Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
mod,
  String
-> Name -> (Integer -> Integer -> (Integer, Integer)) -> CoreRule
rule_divop_both     String
"divModInteger"       Name
divModIntegerName       Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
External instance of the constraint type Integral Integer
divMod,
  String
-> Name -> (Integer -> Integer -> (Integer, Integer)) -> CoreRule
rule_divop_both     String
"quotRemInteger"      Name
quotRemIntegerName      Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
External instance of the constraint type Integral Integer
quotRem,
  -- These rules below don't actually have to be built in, but if we
  -- put them in the Haskell source then we'd have to duplicate them
  -- between all Integer implementations
  String -> Name -> Name -> CoreRule
rule_XToIntegerToX String
"smallIntegerToInt"       Name
integerToIntName    Name
smallIntegerName,
  String -> Name -> Name -> CoreRule
rule_XToIntegerToX String
"wordToIntegerToWord"     Name
integerToWordName   Name
wordToIntegerName,
  String -> Name -> Name -> CoreRule
rule_XToIntegerToX String
"int64ToIntegerToInt64"   Name
integerToInt64Name  Name
int64ToIntegerName,
  String -> Name -> Name -> CoreRule
rule_XToIntegerToX String
"word64ToIntegerToWord64" Name
integerToWord64Name Name
word64ToIntegerName,
  String -> Name -> PrimOp -> CoreRule
rule_smallIntegerTo String
"smallIntegerToWord"   Name
integerToWordName     PrimOp
Int2WordOp,
  String -> Name -> PrimOp -> CoreRule
rule_smallIntegerTo String
"smallIntegerToFloat"  Name
floatFromIntegerName  PrimOp
Int2FloatOp,
  String -> Name -> PrimOp -> CoreRule
rule_smallIntegerTo String
"smallIntegerToDouble" Name
doubleFromIntegerName PrimOp
Int2DoubleOp
  ]
    where rule_convert :: String -> Name -> (Platform -> a -> CoreExpr) -> CoreRule
rule_convert String
str Name
name Platform -> a -> CoreExpr
convert
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = (Platform -> a -> CoreExpr) -> RuleFun
forall a. Num a => (Platform -> a -> CoreExpr) -> RuleFun
Evidence bound by a type signature of the constraint type Num a
match_Integer_convert Platform -> a -> CoreExpr
convert }
          rule_IntToInteger :: String -> Name -> CoreRule
rule_IntToInteger String
str Name
name
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = RuleFun
match_IntToInteger }
          rule_WordToInteger :: String -> Name -> CoreRule
rule_WordToInteger String
str Name
name
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = RuleFun
match_WordToInteger }
          rule_Int64ToInteger :: String -> Name -> CoreRule
rule_Int64ToInteger String
str Name
name
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = RuleFun
match_Int64ToInteger }
          rule_Word64ToInteger :: String -> Name -> CoreRule
rule_Word64ToInteger String
str Name
name
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = RuleFun
match_Word64ToInteger }
          rule_unop :: String -> Name -> (Integer -> Integer) -> CoreRule
rule_unop String
str Name
name Integer -> Integer
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = (Integer -> Integer) -> RuleFun
match_Integer_unop Integer -> Integer
op }
          rule_bitInteger :: String -> Name -> CoreRule
rule_bitInteger String
str Name
name
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = RuleFun
match_bitInteger }
          rule_binop :: String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop String
str Name
name Integer -> Integer -> Integer
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (Integer -> Integer -> Integer) -> RuleFun
match_Integer_binop Integer -> Integer -> Integer
op }
          rule_divop_both :: String
-> Name -> (Integer -> Integer -> (Integer, Integer)) -> CoreRule
rule_divop_both String
str Name
name Integer -> Integer -> (Integer, Integer)
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (Integer -> Integer -> (Integer, Integer)) -> RuleFun
match_Integer_divop_both Integer -> Integer -> (Integer, Integer)
op }
          rule_divop_one :: String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_divop_one String
str Name
name Integer -> Integer -> Integer
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (Integer -> Integer -> Integer) -> RuleFun
match_Integer_divop_one Integer -> Integer -> Integer
op }
          rule_shift_op :: String -> Name -> (Integer -> ConTagZ -> Integer) -> CoreRule
rule_shift_op String
str Name
name Integer -> ConTagZ -> Integer
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (Integer -> ConTagZ -> Integer) -> RuleFun
match_Integer_shift_op Integer -> ConTagZ -> Integer
op }
          rule_binop_Prim :: String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
rule_binop_Prim String
str Name
name Integer -> Integer -> Bool
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (Integer -> Integer -> Bool) -> RuleFun
match_Integer_binop_Prim Integer -> Integer -> Bool
op }
          rule_binop_Ordering :: String -> Name -> (Integer -> Integer -> Ordering) -> CoreRule
rule_binop_Ordering String
str Name
name Integer -> Integer -> Ordering
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (Integer -> Integer -> Ordering) -> RuleFun
match_Integer_binop_Ordering Integer -> Integer -> Ordering
op }
          rule_encodeFloat :: String -> Name -> (a -> CoreExpr) -> CoreRule
rule_encodeFloat String
str Name
name a -> CoreExpr
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (a -> CoreExpr) -> RuleFun
forall a. RealFloat a => (a -> CoreExpr) -> RuleFun
Evidence bound by a type signature of the constraint type RealFloat a
match_Integer_Int_encodeFloat a -> CoreExpr
op }
          rule_decodeDouble :: String -> Name -> CoreRule
rule_decodeDouble String
str Name
name
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = RuleFun
match_decodeDouble }
          rule_XToIntegerToX :: String -> Name -> Name -> CoreRule
rule_XToIntegerToX String
str Name
name Name
toIntegerName
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = Name -> RuleFun
match_XToIntegerToX Name
toIntegerName }
          rule_smallIntegerTo :: String -> Name -> PrimOp -> CoreRule
rule_smallIntegerTo String
str Name
name PrimOp
primOp
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = PrimOp -> RuleFun
match_smallIntegerTo PrimOp
primOp }
          rule_rationalTo :: String -> Name -> (a -> CoreExpr) -> CoreRule
rule_rationalTo String
str Name
name a -> CoreExpr
mkLit
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (a -> CoreExpr) -> RuleFun
forall a. RealFloat a => (a -> CoreExpr) -> RuleFun
Evidence bound by a type signature of the constraint type RealFloat a
match_rationalTo a -> CoreExpr
mkLit }

builtinNaturalRules :: [CoreRule]
builtinNaturalRules :: [CoreRule]
builtinNaturalRules =
 [String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop              String
"plusNatural"        Name
plusNaturalName         Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(+)
 ,String -> Name -> (Integer -> Integer -> Maybe Integer) -> CoreRule
rule_partial_binop      String
"minusNatural"       Name
minusNaturalName        (\Integer
a Integer
b -> if Integer
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
>= Integer
b then Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
- Integer
b) else Maybe Integer
forall a. Maybe a
Nothing)
 ,String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop              String
"timesNatural"       Name
timesNaturalName        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
(*)
 ,String -> Name -> CoreRule
rule_NaturalFromInteger String
"naturalFromInteger" Name
naturalFromIntegerName
 ,String -> Name -> CoreRule
rule_NaturalToInteger   String
"naturalToInteger"   Name
naturalToIntegerName
 ,String -> Name -> CoreRule
rule_WordToNatural      String
"wordToNatural"      Name
wordToNaturalName
 ]
    where rule_binop :: String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
rule_binop String
str Name
name Integer -> Integer -> Integer
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (Integer -> Integer -> Integer) -> RuleFun
match_Natural_binop Integer -> Integer -> Integer
op }
          rule_partial_binop :: String -> Name -> (Integer -> Integer -> Maybe Integer) -> CoreRule
rule_partial_binop String
str Name
name Integer -> Integer -> Maybe Integer
op
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2,
                           ru_try :: RuleFun
ru_try = (Integer -> Integer -> Maybe Integer) -> RuleFun
match_Natural_partial_binop Integer -> Integer -> Maybe Integer
op }
          rule_NaturalToInteger :: String -> Name -> CoreRule
rule_NaturalToInteger String
str Name
name
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = RuleFun
match_NaturalToInteger }
          rule_NaturalFromInteger :: String -> Name -> CoreRule
rule_NaturalFromInteger String
str Name
name
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = RuleFun
match_NaturalFromInteger }
          rule_WordToNatural :: String -> Name -> CoreRule
rule_WordToNatural String
str Name
name
           = BuiltinRule :: RuleName -> Name -> ConTagZ -> RuleFun -> CoreRule
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str, ru_fn :: Name
ru_fn = Name
name, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1,
                           ru_try :: RuleFun
ru_try = RuleFun
match_WordToNatural }

---------------------------------------------------
-- The rule is this:
--      unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
--      =  unpackFoldrCString# "foobaz" c n

match_append_lit :: RuleFun
match_append_lit :: RuleFun
match_append_lit RuleOpts
_ InScopeEnv
id_unf Id
_
        [ Type Kind
ty1
        , CoreExpr
lit1
        , CoreExpr
c1
        , CoreExpr
e2
        ]
  -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the
  -- `lit` and `c` arguments, lest this may fail to fire when building with
  -- -g3. See #16740.
  | ([Tickish Id]
strTicks, Var Id
unpk `App` Type Kind
ty2
                        `App` CoreExpr
lit2
                        `App` CoreExpr
c2
                        `App` CoreExpr
n) <- (Tickish Id -> Bool) -> CoreExpr -> ([Tickish Id], CoreExpr)
forall b. (Tickish Id -> Bool) -> Expr b -> ([Tickish Id], Expr b)
stripTicksTop Tickish Id -> Bool
forall id. Tickish id -> Bool
tickishFloatable CoreExpr
e2
  , Id
unpk Id -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
External instance of the constraint type Uniquable Id
`hasKey` Unique
unpackCStringFoldrIdKey
  , (Tickish Id -> Bool) -> CoreExpr -> CoreExpr -> Bool
forall b. (Tickish Id -> Bool) -> Expr b -> Expr b -> Bool
cheapEqExpr' Tickish Id -> Bool
forall id. Tickish id -> Bool
tickishFloatable CoreExpr
c1 CoreExpr
c2
  , ([Tickish Id]
c1Ticks, CoreExpr
c1') <- (Tickish Id -> Bool) -> CoreExpr -> ([Tickish Id], CoreExpr)
forall b. (Tickish Id -> Bool) -> Expr b -> ([Tickish Id], Expr b)
stripTicksTop Tickish Id -> Bool
forall id. Tickish id -> Bool
tickishFloatable CoreExpr
c1
  , [Tickish Id]
c2Ticks <- (Tickish Id -> Bool) -> CoreExpr -> [Tickish Id]
forall b. (Tickish Id -> Bool) -> Expr b -> [Tickish Id]
stripTicksTopT Tickish Id -> Bool
forall id. Tickish id -> Bool
tickishFloatable CoreExpr
c2
  , Just (LitString ByteString
s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
lit1
  , Just (LitString ByteString
s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
lit2
  = ASSERT( ty1 `eqType` ty2 )
    CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [Tickish Id] -> CoreExpr -> CoreExpr
mkTicks [Tickish Id]
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` Kind -> CoreExpr
forall b. Kind -> Expr b
Type Kind
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` [Tickish Id] -> CoreExpr -> CoreExpr
mkTicks ([Tickish Id]
c1Ticks [Tickish Id] -> [Tickish Id] -> [Tickish Id]
forall a. [a] -> [a] -> [a]
++ [Tickish Id]
c2Ticks) CoreExpr
c1'
                    CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
n

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

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

match_eq_string :: RuleFun
match_eq_string :: RuleFun
match_eq_string RuleOpts
_ InScopeEnv
id_unf Id
_
        [Var Id
unpk1 `App` CoreExpr
lit1, Var Id
unpk2 `App` CoreExpr
lit2]
  | Id
unpk1 Id -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
External instance of the constraint type Uniquable Id
`hasKey` Unique
unpackCStringIdKey
  , Id
unpk2 Id -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
External instance of the constraint type Uniquable Id
`hasKey` Unique
unpackCStringIdKey
  , Just (LitString ByteString
s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
lit1
  , Just (LitString ByteString
s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
lit2
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (if ByteString
s1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq ByteString
== 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
env InScopeEnv
id_unf Id
_ [CoreExpr
lit1]
  | Just (LitString ByteString
str) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf 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
env) (ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral ConTagZ
fromIntegral ConTagZ
len)))
match_cstring_length RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

---------------------------------------------------
-- The rule 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
--       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
--
-- Also, don't forget about 'inline's type argument!
match_inline :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)
match_inline :: [CoreExpr] -> Maybe CoreExpr
match_inline (Type Kind
_ : 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 (Id -> Unfolding
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


-- See Note [magicDictId magic] in `basicTypes/MkId.hs`
-- for a description of what is going on here.
match_magicDict :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)
match_magicDict :: [CoreExpr] -> Maybe CoreExpr
match_magicDict [Type Kind
_, Var Id
wrap `App` Type Kind
a `App` Type Kind
_ `App` CoreExpr
f, CoreExpr
x, CoreExpr
y ]
  | Just (Kind
fieldTy, Kind
_)   <- Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Kind -> Maybe (Kind, Kind)) -> Kind -> Maybe (Kind, Kind)
forall a b. (a -> b) -> a -> b
$ Kind -> Kind
dropForAlls (Kind -> Kind) -> Kind -> Kind
forall a b. (a -> b) -> a -> b
$ Id -> Kind
idType Id
wrap
  , Just (Kind
dictTy, Kind
_)    <- Kind -> Maybe (Kind, Kind)
splitFunTy_maybe Kind
fieldTy
  , Just TyCon
dictTc         <- Kind -> Maybe TyCon
tyConAppTyCon_maybe Kind
dictTy
  , Just ([Id]
_,Kind
_,CoAxiom Unbranched
co)       <- TyCon -> Maybe ([Id], Kind, CoAxiom Unbranched)
unwrapNewTyCon_maybe TyCon
dictTc
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just
  (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ CoreExpr
f CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr -> Coercion -> CoreExpr
forall b. Expr b -> Coercion -> Expr b
Cast CoreExpr
x (Coercion -> Coercion
mkSymCo (Role -> CoAxiom Unbranched -> [Kind] -> [Coercion] -> Coercion
mkUnbranchedAxInstCo Role
Representational CoAxiom Unbranched
co [Kind
a] []))
      CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
y

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

-------------------------------------------------
-- Integer rules
--   smallInteger  (79::Int#)  = 79::Integer
--   wordToInteger (79::Word#) = 79::Integer
-- Similarly Int64, Word64

match_IntToInteger :: RuleFun
match_IntToInteger :: RuleFun
match_IntToInteger = (Integer -> Integer) -> RuleFun
match_IntToInteger_unop Integer -> Integer
forall a. a -> a
id

match_WordToInteger :: RuleFun
match_WordToInteger :: RuleFun
match_WordToInteger RuleOpts
_ InScopeEnv
id_unf Id
id [CoreExpr
xl]
  | Just (LitNumber LitNumType
LitNumWord Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  = case Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Id -> Kind
idType Id
id) of
    Just (Kind
_, Kind
integerTy) ->
        CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitInteger Integer
x Kind
integerTy))
    Maybe (Kind, Kind)
_ ->
        String -> Maybe CoreExpr
forall a. String -> a
panic String
"match_WordToInteger: Id has the wrong type"
match_WordToInteger RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Int64ToInteger :: RuleFun
match_Int64ToInteger :: RuleFun
match_Int64ToInteger RuleOpts
_ InScopeEnv
id_unf Id
id [CoreExpr
xl]
  | Just (LitNumber LitNumType
LitNumInt64 Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  = case Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Id -> Kind
idType Id
id) of
    Just (Kind
_, Kind
integerTy) ->
        CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitInteger Integer
x Kind
integerTy))
    Maybe (Kind, Kind)
_ ->
        String -> Maybe CoreExpr
forall a. String -> a
panic String
"match_Int64ToInteger: Id has the wrong type"
match_Int64ToInteger RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Word64ToInteger :: RuleFun
match_Word64ToInteger :: RuleFun
match_Word64ToInteger RuleOpts
_ InScopeEnv
id_unf Id
id [CoreExpr
xl]
  | Just (LitNumber LitNumType
LitNumWord64 Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  = case Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Id -> Kind
idType Id
id) of
    Just (Kind
_, Kind
integerTy) ->
        CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitInteger Integer
x Kind
integerTy))
    Maybe (Kind, Kind)
_ ->
        String -> Maybe CoreExpr
forall a. String -> a
panic String
"match_Word64ToInteger: Id has the wrong type"
match_Word64ToInteger RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_NaturalToInteger :: RuleFun
match_NaturalToInteger :: RuleFun
match_NaturalToInteger RuleOpts
_ InScopeEnv
id_unf Id
id [CoreExpr
xl]
  | Just (LitNumber LitNumType
LitNumNatural Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  = case Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Id -> Kind
idType Id
id) of
    Just (Kind
_, Kind
naturalTy) ->
        CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (LitNumType -> Integer -> Kind -> Literal
LitNumber LitNumType
LitNumInteger Integer
x Kind
naturalTy))
    Maybe (Kind, Kind)
_ ->
        String -> Maybe CoreExpr
forall a. String -> a
panic String
"match_NaturalToInteger: Id has the wrong type"
match_NaturalToInteger RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_NaturalFromInteger :: RuleFun
match_NaturalFromInteger :: RuleFun
match_NaturalFromInteger RuleOpts
_ InScopeEnv
id_unf Id
id [CoreExpr
xl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
>= Integer
0
  = case Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Id -> Kind
idType Id
id) of
    Just (Kind
_, Kind
naturalTy) ->
        CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (LitNumType -> Integer -> Kind -> Literal
LitNumber LitNumType
LitNumNatural Integer
x Kind
naturalTy))
    Maybe (Kind, Kind)
_ ->
        String -> Maybe CoreExpr
forall a. String -> a
panic String
"match_NaturalFromInteger: Id has the wrong type"
match_NaturalFromInteger RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_WordToNatural :: RuleFun
match_WordToNatural :: RuleFun
match_WordToNatural RuleOpts
_ InScopeEnv
id_unf Id
id [CoreExpr
xl]
  | Just (LitNumber LitNumType
LitNumWord Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  = case Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Id -> Kind
idType Id
id) of
    Just (Kind
_, Kind
naturalTy) ->
        CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (LitNumType -> Integer -> Kind -> Literal
LitNumber LitNumType
LitNumNatural Integer
x Kind
naturalTy))
    Maybe (Kind, Kind)
_ ->
        String -> Maybe CoreExpr
forall a. String -> a
panic String
"match_WordToNatural: Id has the wrong type"
match_WordToNatural RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

-------------------------------------------------
{- Note [Rewriting bitInteger]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For most types the bitInteger operation can be implemented in terms of shifts.
The integer-gmp package, however, can do substantially better than this if
allowed to provide its own implementation. However, in so doing it previously lost
constant-folding (see #8832). The bitInteger rule above provides constant folding
specifically for this function.

There is, however, a bit of trickiness here when it comes to ranges. While the
AST encodes all integers as Integers, `bit` expects the bit
index to be given as an Int. Hence we coerce to an Int in the rule definition.
This will behave a bit funny for constants larger than the word size, but the user
should expect some funniness given that they will have at very least ignored a
warning in this case.
-}

match_bitInteger :: RuleFun
-- Just for GHC.Integer.Type.bitInteger :: Int# -> Integer
match_bitInteger :: RuleFun
match_bitInteger RuleOpts
env InScopeEnv
id_unf Id
fn [CoreExpr
arg]
  | Just (LitNumber LitNumType
LitNumInt Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
arg
  , Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
>= Integer
0
  , Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
<= (ConTagZ -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral ConTagZ
toInteger (Platform -> ConTagZ
platformWordSizeInBits (RuleOpts -> Platform
roPlatform RuleOpts
env)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
- Integer
1)
    -- Make sure x is small enough to yield a decently small integer
    -- Attempting to construct the Integer for
    --    (bitInteger 9223372036854775807#)
    -- would be a bad idea (#14959)
  , let x_int :: ConTagZ
x_int = Integer -> ConTagZ
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num ConTagZ
External instance of the constraint type Integral Integer
fromIntegral Integer
x :: Int
  = case Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Id -> Kind
idType Id
fn) of
    Just (Kind
_, Kind
integerTy)
      -> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (LitNumType -> Integer -> Kind -> Literal
LitNumber LitNumType
LitNumInteger (ConTagZ -> Integer
forall a. Bits a => ConTagZ -> a
External instance of the constraint type Bits Integer
bit ConTagZ
x_int) Kind
integerTy))
    Maybe (Kind, Kind)
_ -> String -> Maybe CoreExpr
forall a. String -> a
panic String
"match_IntToInteger_unop: Id has the wrong type"

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


-------------------------------------------------
match_Integer_convert :: Num a
                      => (Platform -> a -> Expr CoreBndr)
                      -> RuleFun
match_Integer_convert :: (Platform -> a -> CoreExpr) -> RuleFun
match_Integer_convert Platform -> a -> CoreExpr
convert RuleOpts
env InScopeEnv
id_unf Id
_ [CoreExpr
xl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Platform -> a -> CoreExpr
convert (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
Evidence bound by a type signature of the constraint type Num a
fromInteger Integer
x))
match_Integer_convert Platform -> a -> CoreExpr
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Integer_unop :: (Integer -> Integer) -> RuleFun
match_Integer_unop :: (Integer -> Integer) -> RuleFun
match_Integer_unop Integer -> Integer
unop RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
i) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (LitNumType -> Integer -> Kind -> Literal
LitNumber LitNumType
LitNumInteger (Integer -> Integer
unop Integer
x) Kind
i))
match_Integer_unop Integer -> Integer
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_IntToInteger_unop :: (Integer -> Integer) -> RuleFun
match_IntToInteger_unop :: (Integer -> Integer) -> RuleFun
match_IntToInteger_unop Integer -> Integer
unop RuleOpts
_ InScopeEnv
id_unf Id
fn [CoreExpr
xl]
  | Just (LitNumber LitNumType
LitNumInt Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  = case Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Id -> Kind
idType Id
fn) of
    Just (Kind
_, Kind
integerTy) ->
        CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (LitNumType -> Integer -> Kind -> Literal
LitNumber LitNumType
LitNumInteger (Integer -> Integer
unop Integer
x) Kind
integerTy))
    Maybe (Kind, Kind)
_ ->
        String -> Maybe CoreExpr
forall a. String -> a
panic String
"match_IntToInteger_unop: Id has the wrong type"
match_IntToInteger_unop Integer -> Integer
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Integer_binop :: (Integer -> Integer -> Integer) -> RuleFun
match_Integer_binop :: (Integer -> Integer -> Integer) -> RuleFun
match_Integer_binop Integer -> Integer -> Integer
binop RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl,CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
i) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumInteger Integer
y Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitInteger (Integer
x Integer -> Integer -> Integer
`binop` Integer
y) Kind
i))
match_Integer_binop Integer -> Integer -> Integer
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Natural_binop :: (Integer -> Integer -> Integer) -> RuleFun
match_Natural_binop :: (Integer -> Integer -> Integer) -> RuleFun
match_Natural_binop Integer -> Integer -> Integer
binop RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl,CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumNatural Integer
x Kind
i) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumNatural Integer
y Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitNatural (Integer
x Integer -> Integer -> Integer
`binop` Integer
y) Kind
i))
match_Natural_binop Integer -> Integer -> Integer
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Natural_partial_binop :: (Integer -> Integer -> Maybe Integer) -> RuleFun
match_Natural_partial_binop :: (Integer -> Integer -> Maybe Integer) -> RuleFun
match_Natural_partial_binop Integer -> Integer -> Maybe Integer
binop RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl,CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumNatural Integer
x Kind
i) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumNatural Integer
y Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  , Just Integer
z <- Integer
x Integer -> Integer -> Maybe Integer
`binop` Integer
y
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitNatural Integer
z Kind
i))
match_Natural_partial_binop Integer -> Integer -> Maybe Integer
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

-- This helper is used for the quotRem and divMod functions
match_Integer_divop_both
   :: (Integer -> Integer -> (Integer, Integer)) -> RuleFun
match_Integer_divop_both :: (Integer -> Integer -> (Integer, Integer)) -> RuleFun
match_Integer_divop_both Integer -> Integer -> (Integer, Integer)
divop RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl,CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
t) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumInteger Integer
y Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  , Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
/= Integer
0
  , (Integer
r,Integer
s) <- Integer
x Integer -> Integer -> (Integer, Integer)
`divop` Integer
y
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [Kind] -> [CoreExpr] -> CoreExpr
mkCoreUbxTup [Kind
t,Kind
t] [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitInteger Integer
r Kind
t), Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitInteger Integer
s Kind
t)]
match_Integer_divop_both Integer -> Integer -> (Integer, Integer)
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

-- This helper is used for the quot and rem functions
match_Integer_divop_one :: (Integer -> Integer -> Integer) -> RuleFun
match_Integer_divop_one :: (Integer -> Integer -> Integer) -> RuleFun
match_Integer_divop_one Integer -> Integer -> Integer
divop RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl,CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
i) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumInteger Integer
y Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  , Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
/= Integer
0
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitInteger (Integer
x Integer -> Integer -> Integer
`divop` Integer
y) Kind
i))
match_Integer_divop_one Integer -> Integer -> Integer
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Integer_shift_op :: (Integer -> Int -> Integer) -> RuleFun
-- Used for shiftLInteger, shiftRInteger :: Integer -> Int# -> Integer
-- See Note [Guarding against silly shifts]
match_Integer_shift_op :: (Integer -> ConTagZ -> Integer) -> RuleFun
match_Integer_shift_op Integer -> ConTagZ -> Integer
binop RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl,CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
i) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumInt Integer
y Kind
_)     <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  , Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
>= Integer
0
  , Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
<= Integer
4   -- Restrict constant-folding of shifts on Integers, somewhat
             -- arbitrary.  We can get huge shifts in inaccessible code
             -- (#15673)
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitInteger (Integer
x Integer -> ConTagZ -> Integer
`binop` Integer -> ConTagZ
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num ConTagZ
External instance of the constraint type Integral Integer
fromIntegral Integer
y) Kind
i))
match_Integer_shift_op Integer -> ConTagZ -> Integer
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Integer_binop_Prim :: (Integer -> Integer -> Bool) -> RuleFun
match_Integer_binop_Prim :: (Integer -> Integer -> Bool) -> RuleFun
match_Integer_binop_Prim Integer -> Integer -> Bool
binop RuleOpts
env InScopeEnv
id_unf Id
_ [CoreExpr
xl, CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumInteger Integer
y Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (if Integer
x Integer -> Integer -> Bool
`binop` Integer
y then Platform -> CoreExpr
trueValInt (RuleOpts -> Platform
roPlatform RuleOpts
env) else Platform -> CoreExpr
falseValInt (RuleOpts -> Platform
roPlatform RuleOpts
env))
match_Integer_binop_Prim Integer -> Integer -> Bool
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Integer_binop_Ordering :: (Integer -> Integer -> Ordering) -> RuleFun
match_Integer_binop_Ordering :: (Integer -> Integer -> Ordering) -> RuleFun
match_Integer_binop_Ordering Integer -> Integer -> Ordering
binop RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl, CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumInteger Integer
y Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ case Integer
x Integer -> Integer -> Ordering
`binop` Integer
y of
             Ordering
LT -> CoreExpr
ltVal
             Ordering
EQ -> CoreExpr
eqVal
             Ordering
GT -> CoreExpr
gtVal
match_Integer_binop_Ordering Integer -> Integer -> Ordering
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_Integer_Int_encodeFloat :: RealFloat a
                              => (a -> Expr CoreBndr)
                              -> RuleFun
match_Integer_Int_encodeFloat :: (a -> CoreExpr) -> RuleFun
match_Integer_Int_encodeFloat a -> CoreExpr
mkLit RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl,CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumInt Integer
y Kind
_)     <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (a -> CoreExpr
mkLit (a -> CoreExpr) -> a -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> ConTagZ -> a
forall a. RealFloat a => Integer -> ConTagZ -> a
Evidence bound by a type signature of the constraint type RealFloat a
encodeFloat Integer
x (Integer -> ConTagZ
forall a. Num a => Integer -> a
External instance of the constraint type Num ConTagZ
fromInteger Integer
y))
match_Integer_Int_encodeFloat a -> CoreExpr
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

---------------------------------------------------
-- constant folding for Float/Double
--
-- This turns
--      rationalToFloat n d
-- into a literal Float, and similarly for Doubles.
--
-- 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
match_rationalTo :: RealFloat a
                 => (a -> Expr CoreBndr)
                 -> RuleFun
match_rationalTo :: (a -> CoreExpr) -> RuleFun
match_rationalTo a -> CoreExpr
mkLit RuleOpts
_ InScopeEnv
id_unf Id
_ [CoreExpr
xl, CoreExpr
yl]
  | Just (LitNumber LitNumType
LitNumInteger Integer
x Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  , Just (LitNumber LitNumType
LitNumInteger Integer
y Kind
_) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
yl
  , Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
/= Integer
0
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (a -> CoreExpr
mkLit (Rational -> a
forall a. Fractional a => Rational -> a
External instance of the constraint type forall a. RealFrac a => Fractional a
External instance of the constraint type forall a. RealFloat a => RealFrac a
Evidence bound by a type signature of the constraint type RealFloat a
fromRational (Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
External instance of the constraint type Integral Integer
% Integer
y)))
match_rationalTo a -> CoreExpr
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_decodeDouble :: RuleFun
match_decodeDouble :: RuleFun
match_decodeDouble RuleOpts
env InScopeEnv
id_unf Id
fn [CoreExpr
xl]
  | Just (LitDouble Rational
x) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
id_unf CoreExpr
xl
  = case Kind -> Maybe (Kind, Kind)
splitFunTy_maybe (Id -> Kind
idType Id
fn) of
    Just (Kind
_, Kind
res)
      | Just [Kind
_lev1, Kind
_lev2, Kind
integerTy, Kind
intHashTy] <- Kind -> Maybe [Kind]
tyConAppArgs_maybe Kind
res
      -> case Double -> (Integer, ConTagZ)
forall a. RealFloat a => a -> (Integer, ConTagZ)
External instance of the constraint type RealFloat Double
decodeFloat (Rational -> Double
forall a. Fractional a => Rational -> a
External instance of the constraint type Fractional Double
fromRational Rational
x :: Double) of
           (Integer
y, ConTagZ
z) ->
             CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [Kind] -> [CoreExpr] -> CoreExpr
mkCoreUbxTup [Kind
integerTy, Kind
intHashTy]
                                 [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Kind -> Literal
mkLitInteger Integer
y Kind
integerTy),
                                  Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitInt (RuleOpts -> Platform
roPlatform RuleOpts
env) (ConTagZ -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral ConTagZ
toInteger ConTagZ
z))]
    Maybe (Kind, Kind)
_ ->
        String -> SDoc -> Maybe CoreExpr
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"match_decodeDouble: Id has the wrong type"
          (Id -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Id
ppr Id
fn SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Kind -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Kind
ppr (Id -> Kind
idType Id
fn))
match_decodeDouble RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_XToIntegerToX :: Name -> RuleFun
match_XToIntegerToX :: Name -> RuleFun
match_XToIntegerToX Name
n RuleOpts
_ InScopeEnv
_ Id
_ [App (Var Id
x) CoreExpr
y]
  | Id -> Name
idName Id
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Name
== Name
n
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just CoreExpr
y
match_XToIntegerToX Name
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing

match_smallIntegerTo :: PrimOp -> RuleFun
match_smallIntegerTo :: PrimOp -> RuleFun
match_smallIntegerTo PrimOp
primOp RuleOpts
_ InScopeEnv
_ Id
_ [App (Var Id
x) CoreExpr
y]
  | Id -> Name
idName Id
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Name
== Name
smallIntegerName
  = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
mkPrimOpId PrimOp
primOp)) CoreExpr
y
match_smallIntegerTo PrimOp
_ RuleOpts
_ InScopeEnv
_ Id
_ [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) * simplification
--    ops = *, 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]
numFoldingRules :: PrimOp -> (Platform -> PrimOps) -> RuleM CoreExpr
numFoldingRules :: PrimOp -> (Platform -> PrimOps) -> RuleM CoreExpr
numFoldingRules PrimOp
op Platform -> PrimOps
dict = do
  RuleOpts
env <- RuleM RuleOpts
getEnv
  if Bool -> Bool
not (RuleOpts -> Bool
roNumConstantFolding RuleOpts
env)
   then RuleM CoreExpr
forall (m :: * -> *) a. MonadPlus m => m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
mzero
   else do
    [CoreExpr
e1,CoreExpr
e2] <- RuleM [CoreExpr]
getArgs
    Platform
platform <- RuleM Platform
getPlatform
    let PrimOps{Integer -> CoreExpr
CoreExpr -> CoreExpr -> CoreExpr
mkL :: PrimOps -> Integer -> CoreExpr
mul :: PrimOps -> CoreExpr -> CoreExpr -> CoreExpr
sub :: PrimOps -> CoreExpr -> CoreExpr -> CoreExpr
add :: PrimOps -> CoreExpr -> CoreExpr -> CoreExpr
mkL :: Integer -> CoreExpr
mul :: CoreExpr -> CoreExpr -> CoreExpr
sub :: CoreExpr -> CoreExpr -> CoreExpr
add :: CoreExpr -> CoreExpr -> CoreExpr
..} = Platform -> PrimOps
dict Platform
platform
    case CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
e1 PrimOp
op CoreExpr
e2 of
     -- R1) +/- simplification
     Integer
x    :++: (Integer
y :++: CoreExpr
v)          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v
     Integer
x    :++: (L Integer
y :-: CoreExpr
v)         -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v
     Integer
x    :++: (CoreExpr
v   :-: L Integer
y)       -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v
     L Integer
x  :-:  (Integer
y :++: CoreExpr
v)          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v
     L Integer
x  :-:  (L Integer
y :-: CoreExpr
v)         -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v
     L Integer
x  :-:  (CoreExpr
v   :-: L Integer
y)       -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v

     (Integer
y :++: CoreExpr
v)    :-: L Integer
x         -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
x)   CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v
     (L Integer
y :-: CoreExpr
v)   :-: L Integer
x         -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
x)   CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v
     (CoreExpr
v   :-: L Integer
y) :-: L Integer
x         -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
0Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
x) CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v

     (Integer
x :++: CoreExpr
w)  :+: (Integer
y :++: CoreExpr
v)    -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v)
     (CoreExpr
w :-: L Integer
x) :+: (L Integer
y :-: CoreExpr
v)   -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
x)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v)
     (CoreExpr
w :-: L Integer
x) :+: (CoreExpr
v   :-: L Integer
y) -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
0Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v)
     (L Integer
x :-: CoreExpr
w) :+: (L Integer
y :-: CoreExpr
v)   -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`sub` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v)
     (L Integer
x :-: CoreExpr
w) :+: (CoreExpr
v   :-: L Integer
y) -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
w)
     (CoreExpr
w :-: L Integer
x) :+: (Integer
y :++: CoreExpr
v)    -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
x)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v)
     (L Integer
x :-: CoreExpr
w) :+: (Integer
y :++: CoreExpr
v)    -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
w)
     (Integer
y :++: CoreExpr
v)  :+: (CoreExpr
w :-: L Integer
x)   -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
x)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v)
     (Integer
y :++: CoreExpr
v)  :+: (L Integer
x :-: CoreExpr
w)   -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
w)

     (CoreExpr
v   :-: L Integer
y) :-: (CoreExpr
w :-: L Integer
x) -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
w)
     (CoreExpr
v   :-: L Integer
y) :-: (L Integer
x :-: CoreExpr
w) -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
0Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
w)
     (L Integer
y :-:   CoreExpr
v) :-: (CoreExpr
w :-: L Integer
x) -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`sub` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
w)
     (L Integer
y :-:   CoreExpr
v) :-: (L Integer
x :-: CoreExpr
w) -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
x)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v)
     (Integer
x :++: CoreExpr
w)    :-: (Integer
y :++: CoreExpr
v)  -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v)
     (CoreExpr
w :-: L Integer
x)   :-: (Integer
y :++: CoreExpr
v)  -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
0Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
x) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v)
     (L Integer
x :-: CoreExpr
w)   :-: (Integer
y :++: CoreExpr
v)  -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`sub` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
w)
     (Integer
y :++: CoreExpr
v)    :-: (CoreExpr
w :-: L Integer
x) -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
x)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
w)
     (Integer
y :++: CoreExpr
v)    :-: (L Integer
x :-: CoreExpr
w) -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
x)   CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
w)

     -- R2) * simplification
     Integer
x :**: (Integer
y :**: CoreExpr
v)             -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v
     (Integer
x :**: CoreExpr
w) :*: (Integer
y :**: CoreExpr
v)     -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`mul` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v)

     -- R3) * distribution over +/-
     Integer
x :**: (Integer
y :++: CoreExpr
v)             -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`add` (Integer -> CoreExpr
mkL Integer
x CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v)
     Integer
x :**: (L Integer
y :-: CoreExpr
v)            -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`sub` (Integer -> CoreExpr
mkL Integer
x CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v)
     Integer
x :**: (CoreExpr
v   :-: L Integer
y)          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> CoreExpr
mkL Integer
x CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
y)

     -- R4) Simple factorization
     CoreExpr
v :+: CoreExpr
w
      | CoreExpr
w CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
v          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL Integer
2       CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v
     CoreExpr
w :+: (Integer
y :**: CoreExpr
v)
      | CoreExpr
w CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
v          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v
     CoreExpr
w :-: (Integer
y :**: CoreExpr
v)
      | CoreExpr
w CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
v          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v
     (Integer
y :**: CoreExpr
v) :+: CoreExpr
w
      | CoreExpr
w CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
v          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
1)   CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v
     (Integer
y :**: CoreExpr
v) :-: CoreExpr
w
      | CoreExpr
w CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
v          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
1)   CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v
     (Integer
x :**: CoreExpr
w) :+: (Integer
y :**: CoreExpr
v)
      | CoreExpr
w CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
v          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v
     (Integer
x :**: CoreExpr
w) :-: (Integer
y :**: CoreExpr
v)
      | CoreExpr
w CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
v          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
y)   CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
v

     -- R5) +/- propagation
     CoreExpr
w  :+: (Integer
y :++: CoreExpr
v)             -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL Integer
y CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v)
     (Integer
y :++: CoreExpr
v) :+: CoreExpr
w              -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL Integer
y       CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v)
     CoreExpr
w  :-: (Integer
y :++: CoreExpr
v)             -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL Integer
y
     (Integer
y :++: CoreExpr
v) :-: CoreExpr
w              -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL Integer
y       CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
v CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
w)
     CoreExpr
w    :-: (L Integer
y :-: CoreExpr
v)          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL Integer
y
     (L Integer
y :-: CoreExpr
v) :-: CoreExpr
w             -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL Integer
y       CoreExpr -> CoreExpr -> CoreExpr
`sub` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v)
     CoreExpr
w    :+: (L Integer
y :-: CoreExpr
v)          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL Integer
y       CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v)
     CoreExpr
w    :+: (CoreExpr
v :-: L Integer
y)          -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL Integer
y
     (L Integer
y :-: CoreExpr
v) :+: CoreExpr
w             -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> CoreExpr
mkL Integer
y       CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
v)
     (CoreExpr
v :-: L Integer
y) :+: CoreExpr
w             -> CoreExpr -> RuleM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
Instance of class: Monad of the constraint type Monad RuleM
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (CoreExpr
w CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
v) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL Integer
y

     CoreExpr
_                             -> RuleM CoreExpr
forall (m :: * -> *) a. MonadPlus m => m a
Instance of class: MonadPlus of the constraint type MonadPlus RuleM
mzero



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

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



-- | Match a literal
pattern L :: Integer -> Arg CoreBndr
pattern $mL :: forall {r}. CoreExpr -> (Integer -> r) -> (Void# -> r) -> r
L l <- Lit (isLitValue_maybe -> Just l)

-- | Match an addition
pattern (:+:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr
pattern x $m:+: :: forall {r}.
CoreExpr -> (CoreExpr -> CoreExpr -> r) -> (Void# -> r) -> r
:+: y <- BinOpApp x (isAddOp -> True) y

-- | Match an addition with a literal (handle commutativity)
pattern (:++:) :: Integer -> Arg CoreBndr -> CoreExpr
pattern l $m:++: :: forall {r}.
CoreExpr -> (Integer -> CoreExpr -> r) -> (Void# -> r) -> r
:++: x <- (isAdd -> Just (l,x))

isAdd :: CoreExpr -> Maybe (Integer,CoreExpr)
isAdd :: CoreExpr -> Maybe (Integer, CoreExpr)
isAdd CoreExpr
e = case CoreExpr
e of
   L Integer
l :+: CoreExpr
x   -> (Integer, CoreExpr) -> Maybe (Integer, CoreExpr)
forall a. a -> Maybe a
Just (Integer
l,CoreExpr
x)
   CoreExpr
x   :+: L Integer
l -> (Integer, CoreExpr) -> Maybe (Integer, CoreExpr)
forall a. a -> Maybe a
Just (Integer
l,CoreExpr
x)
   CoreExpr
_           -> Maybe (Integer, CoreExpr)
forall a. Maybe a
Nothing

-- | Match a multiplication
pattern (:*:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr
pattern x $m:*: :: forall {r}.
CoreExpr -> (CoreExpr -> CoreExpr -> r) -> (Void# -> r) -> r
:*: y <- BinOpApp x (isMulOp -> True) y

-- | Match a multiplication with a literal (handle commutativity)
pattern (:**:) :: Integer -> Arg CoreBndr -> CoreExpr
pattern l $m:**: :: forall {r}.
CoreExpr -> (Integer -> CoreExpr -> r) -> (Void# -> r) -> r
:**: x <- (isMul -> Just (l,x))

isMul :: CoreExpr -> Maybe (Integer,CoreExpr)
isMul :: CoreExpr -> Maybe (Integer, CoreExpr)
isMul CoreExpr
e = case CoreExpr
e of
   L Integer
l :*: CoreExpr
x   -> (Integer, CoreExpr) -> Maybe (Integer, CoreExpr)
forall a. a -> Maybe a
Just (Integer
l,CoreExpr
x)
   CoreExpr
x   :*: L Integer
l -> (Integer, CoreExpr) -> Maybe (Integer, CoreExpr)
forall a. a -> Maybe a
Just (Integer
l,CoreExpr
x)
   CoreExpr
_           -> Maybe (Integer, CoreExpr)
forall a. Maybe a
Nothing


-- | Match a subtraction
pattern (:-:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr
pattern x $m:-: :: forall {r}.
CoreExpr -> (CoreExpr -> CoreExpr -> r) -> (Void# -> r) -> r
:-: y <- BinOpApp x (isSubOp -> True) y

isSubOp :: PrimOp -> Bool
isSubOp :: PrimOp -> Bool
isSubOp PrimOp
IntSubOp  = Bool
True
isSubOp PrimOp
WordSubOp = Bool
True
isSubOp PrimOp
_         = Bool
False

isAddOp :: PrimOp -> Bool
isAddOp :: PrimOp -> Bool
isAddOp PrimOp
IntAddOp  = Bool
True
isAddOp PrimOp
WordAddOp = Bool
True
isAddOp PrimOp
_         = Bool
False

isMulOp :: PrimOp -> Bool
isMulOp :: PrimOp -> Bool
isMulOp PrimOp
IntMulOp  = Bool
True
isMulOp PrimOp
WordMulOp = Bool
True
isMulOp PrimOp
_         = Bool
False

-- | Explicit "type-class"-like dictionary for numeric primops
--
-- Depends on Platform because creating a literal value depends on Platform
data PrimOps = PrimOps
   { PrimOps -> CoreExpr -> CoreExpr -> CoreExpr
add :: CoreExpr -> CoreExpr -> CoreExpr -- ^ Add two numbers
   , PrimOps -> CoreExpr -> CoreExpr -> CoreExpr
sub :: CoreExpr -> CoreExpr -> CoreExpr -- ^ Sub two numbers
   , PrimOps -> CoreExpr -> CoreExpr -> CoreExpr
mul :: CoreExpr -> CoreExpr -> CoreExpr -- ^ Multiply two numbers
   , PrimOps -> Integer -> CoreExpr
mkL :: Integer -> CoreExpr              -- ^ Create a literal value
   }

intPrimOps :: Platform -> PrimOps
intPrimOps :: Platform -> PrimOps
intPrimOps Platform
platform = PrimOps :: (CoreExpr -> CoreExpr -> CoreExpr)
-> (CoreExpr -> CoreExpr -> CoreExpr)
-> (CoreExpr -> CoreExpr -> CoreExpr)
-> (Integer -> CoreExpr)
-> PrimOps
PrimOps
   { add :: CoreExpr -> CoreExpr -> CoreExpr
add = \CoreExpr
x CoreExpr
y -> CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x PrimOp
IntAddOp CoreExpr
y
   , sub :: CoreExpr -> CoreExpr -> CoreExpr
sub = \CoreExpr
x CoreExpr
y -> CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x PrimOp
IntSubOp CoreExpr
y
   , mul :: CoreExpr -> CoreExpr -> CoreExpr
mul = \CoreExpr
x CoreExpr
y -> CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x PrimOp
IntMulOp CoreExpr
y
   , mkL :: Integer -> CoreExpr
mkL = Platform -> Integer -> CoreExpr
intResult' Platform
platform
   }

wordPrimOps :: Platform -> PrimOps
wordPrimOps :: Platform -> PrimOps
wordPrimOps Platform
platform = PrimOps :: (CoreExpr -> CoreExpr -> CoreExpr)
-> (CoreExpr -> CoreExpr -> CoreExpr)
-> (CoreExpr -> CoreExpr -> CoreExpr)
-> (Integer -> CoreExpr)
-> PrimOps
PrimOps
   { add :: CoreExpr -> CoreExpr -> CoreExpr
add = \CoreExpr
x CoreExpr
y -> CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x PrimOp
WordAddOp CoreExpr
y
   , sub :: CoreExpr -> CoreExpr -> CoreExpr
sub = \CoreExpr
x CoreExpr
y -> CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x PrimOp
WordSubOp CoreExpr
y
   , mul :: CoreExpr -> CoreExpr -> CoreExpr
mul = \CoreExpr
x CoreExpr
y -> CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x PrimOp
WordMulOp CoreExpr
y
   , mkL :: Integer -> CoreExpr
mkL = Platform -> Integer -> CoreExpr
wordResult' Platform
platform
   }


--------------------------------------------------------
-- 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
  , Just Integer
x  <- Literal -> Maybe Integer
isLitValue_maybe 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
  , Just Integer
x  <- Literal -> Maybe Integer
isLitValue_maybe 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
_ (App (App (Var Id
f) (Type Kind
ty)) CoreExpr
v)       -- dataToTag x
  | Just PrimOp
DataToTagOp <- Id -> Maybe PrimOp
isPrimOpId_maybe Id
f
  , Just (TyCon
tc, [Kind]
_) <- HasCallStack => Kind -> Maybe (TyCon, [Kind])
Kind -> Maybe (TyCon, [Kind])
tcSplitTyConApp_maybe Kind
ty
  , TyCon -> Bool
isAlgTyCon TyCon
tc
  = (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
-> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
forall a. a -> Maybe a
Just (CoreExpr
v, Kind -> AltCon -> Maybe AltCon
tx_con_dtt Kind
ty
           , \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) (Kind -> CoreExpr
forall b. Kind -> Expr b
Type Kind
ty)) (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
v))

caseRules Platform
_ CoreExpr
_ = Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
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
External instance of the constraint type Outputable AltCon
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
External instance of the constraint type Num Integer
-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
External instance of the constraint type Num Integer
-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
External instance of the constraint type Num Integer
+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
External instance of the constraint type Num Integer
+Integer
lit      )
         PrimOp
XorOp     -> (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
External instance of the constraint type Bits Integer
`xor` Integer
lit)
         PrimOp
XorIOp    -> (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
External instance of the constraint type Bits Integer
`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
External instance of the constraint type Num Integer
-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
External instance of the constraint type Num Integer
-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
External instance of the constraint type Num Integer
-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
External instance of the constraint type Num Integer
-Integer
y      )
         PrimOp
XorOp     -> (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
External instance of the constraint type Bits Integer
`xor` Integer
lit)
         PrimOp
XorIOp    -> (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
External instance of the constraint type Bits Integer
`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
NotOp     -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer -> Integer
forall a. Bits a => a -> a
External instance of the constraint type Bits Integer
complement Integer
y)
         PrimOp
NotIOp    -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer -> Integer
forall a. Bits a => a -> a
External instance of the constraint type Bits Integer
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
External instance of the constraint type Num Integer
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
External instance of the constraint type Outputable AltCon
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
External instance of the constraint type Integral ConTagZ
toInteger (ConTagZ -> Integer) -> ConTagZ -> Integer
forall a b. (a -> b) -> a -> b
$ DataCon -> ConTagZ
dataConTagZ DataCon
dc

tx_con_dtt :: Type -> AltCon -> Maybe AltCon
tx_con_dtt :: Kind -> AltCon -> Maybe AltCon
tx_con_dtt Kind
_  AltCon
DEFAULT = AltCon -> Maybe AltCon
forall a. a -> Maybe a
Just AltCon
DEFAULT
tx_con_dtt Kind
ty (LitAlt (LitNumber LitNumType
LitNumInt Integer
i Kind
_))
   | ConTagZ
tag ConTagZ -> ConTagZ -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord ConTagZ
>= ConTagZ
0
   , ConTagZ
tag ConTagZ -> ConTagZ -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord ConTagZ
< ConTagZ
n_data_cons
   = AltCon -> Maybe AltCon
forall a. a -> Maybe a
Just (DataCon -> AltCon
DataAlt ([DataCon]
data_cons [DataCon] -> ConTagZ -> DataCon
forall a. [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
External instance of the constraint type Num ConTagZ
fromInteger Integer
i :: ConTagZ
     tc :: TyCon
tc          = Kind -> TyCon
tyConAppTyCon Kind
ty
     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 Kind
_ AltCon
alt = String -> SDoc -> Maybe AltCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"caseRules" (AltCon -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable AltCon
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

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, we deal with turning one branch into DEFAULT in GHC.Core.Opt.Simplify.Utils
(add_default in mkCase3).

Note [caseRules for dataToTag]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also Note [dataToTag#] in primpops.txt.pp

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

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

For the time, we only apply this transformation when the type of `x` is a type
headed by a normal tycon. In particular, we do not apply this in the case of a
data family tycon, since that would require carefully applying coercion(s)
between the data family and the data family instance's representation type,
which caseRules isn't currently engineered to handle (#14680).

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.
-}