{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE -Wno-incomplete-uni-patterns #-}
module GHC.Core.Opt.ConstantFold
( primOpRules
, builtinRules
, caseRules
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Types.Id.Make ( unboxedUnitExpr )
import GHC.Types.Id
import GHC.Types.Literal
import GHC.Types.Name.Occurrence ( occNameFS )
import GHC.Types.Tickish
import GHC.Types.Name ( Name, nameOccName )
import GHC.Types.Basic
import GHC.Core
import GHC.Core.Make
import GHC.Core.SimpleOpt ( exprIsConApp_maybe, exprIsLiteral_maybe )
import GHC.Core.DataCon ( DataCon,dataConTagZ, dataConTyCon, dataConWrapId, dataConWorkId )
import GHC.Core.Utils ( cheapEqExpr, exprIsHNF
, stripTicksTop, stripTicksTopT, mkTicks )
import GHC.Core.Multiplicity
import GHC.Core.Rules.Config
import GHC.Core.Type
import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.TyCon
( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon
, isNewTyCon, tyConDataCons
, tyConFamilySize )
import GHC.Core.Map.Expr ( eqCoreExpr )
import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey )
import GHC.Builtin.PrimOps.Ids (primOpId)
import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Builtin.Names
import GHC.Data.FastString
import GHC.Data.Maybe ( orElse )
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import Control.Applicative ( Alternative(..) )
import Control.Monad
import Data.Functor (($>))
import qualified Data.ByteString as BS
import Data.Ratio
import Data.Word
import Data.Maybe (fromMaybe, fromJust)
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 ]
PrimOp
Int8AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zeroI8
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Int8AddOp NumOps
int8Ops
]
PrimOp
Int8SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI8
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI8
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Int8SubOp NumOps
int8Ops
]
PrimOp
Int8MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, RuleM CoreExpr
zeroElem
, Literal -> RuleM CoreExpr
identity Literal
oneI8
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Int8MulOp NumOps
int8Ops
]
PrimOp
Int8QuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, RuleM CoreExpr
leftZero
, Literal -> RuleM CoreExpr
rightIdentity Literal
oneI8
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
oneI8 ]
PrimOp
Int8RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI8
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI8 ]
PrimOp
Int8NegOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Int8NegOp ]
PrimOp
Int8SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt8 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI8 ]
PrimOp
Int8SraOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt8 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI8 ]
PrimOp
Int8SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt8 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word8
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI8 ]
PrimOp
Word8AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zeroW8
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Word8AddOp NumOps
word8Ops
]
PrimOp
Word8SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroW8
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW8
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Word8SubOp NumOps
word8Ops
]
PrimOp
Word8MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, Literal -> RuleM CoreExpr
identity Literal
oneW8
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Word8MulOp NumOps
word8Ops
]
PrimOp
Word8QuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, Literal -> RuleM CoreExpr
rightIdentity Literal
oneW8 ]
PrimOp
Word8RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW8
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW8 ]
PrimOp
Word8AndOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
, RuleM CoreExpr
idempotent
, RuleM CoreExpr
zeroElem
, Literal -> RuleM CoreExpr
identity (Integer -> Literal
mkLitWord8 Integer
0xFF)
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word8AndOp
, NumOps -> RuleM CoreExpr
andFoldingRules NumOps
word8Ops
]
PrimOp
Word8OrOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
, RuleM CoreExpr
idempotent
, Literal -> RuleM CoreExpr
identity Literal
zeroW8
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word8OrOp
, NumOps -> RuleM CoreExpr
orFoldingRules NumOps
word8Ops
]
PrimOp
Word8XorOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
, Literal -> RuleM CoreExpr
identity Literal
zeroW8
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW8 ]
PrimOp
Word8NotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Word8NotOp ]
PrimOp
Word8SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord8 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
PrimOp
Word8SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord8 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word8 ]
PrimOp
Int16AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zeroI16
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Int16AddOp NumOps
int16Ops
]
PrimOp
Int16SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI16
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI16
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Int16SubOp NumOps
int16Ops
]
PrimOp
Int16MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, RuleM CoreExpr
zeroElem
, Literal -> RuleM CoreExpr
identity Literal
oneI16
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Int16MulOp NumOps
int16Ops
]
PrimOp
Int16QuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, RuleM CoreExpr
leftZero
, Literal -> RuleM CoreExpr
rightIdentity Literal
oneI16
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
oneI16 ]
PrimOp
Int16RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI16
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI16 ]
PrimOp
Int16NegOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Int16NegOp ]
PrimOp
Int16SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt16 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI16 ]
PrimOp
Int16SraOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt16 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI16 ]
PrimOp
Int16SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt16 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word16
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI16 ]
PrimOp
Word16AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zeroW16
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Word16AddOp NumOps
word16Ops
]
PrimOp
Word16SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroW16
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW16
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Word16SubOp NumOps
word16Ops
]
PrimOp
Word16MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, Literal -> RuleM CoreExpr
identity Literal
oneW16
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Word16MulOp NumOps
word16Ops
]
PrimOp
Word16QuotOp-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, Literal -> RuleM CoreExpr
rightIdentity Literal
oneW16 ]
PrimOp
Word16RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW16
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW16 ]
PrimOp
Word16AndOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
, RuleM CoreExpr
idempotent
, RuleM CoreExpr
zeroElem
, Literal -> RuleM CoreExpr
identity (Integer -> Literal
mkLitWord16 Integer
0xFFFF)
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word16AndOp
, NumOps -> RuleM CoreExpr
andFoldingRules NumOps
word16Ops
]
PrimOp
Word16OrOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
, RuleM CoreExpr
idempotent
, Literal -> RuleM CoreExpr
identity Literal
zeroW16
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word16OrOp
, NumOps -> RuleM CoreExpr
orFoldingRules NumOps
word16Ops
]
PrimOp
Word16XorOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
, Literal -> RuleM CoreExpr
identity Literal
zeroW16
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW16 ]
PrimOp
Word16NotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Word16NotOp ]
PrimOp
Word16SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord16 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
PrimOp
Word16SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord16 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word16 ]
PrimOp
Int32AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zeroI32
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Int32AddOp NumOps
int32Ops
]
PrimOp
Int32SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI32
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI32
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Int32SubOp NumOps
int32Ops
]
PrimOp
Int32MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, RuleM CoreExpr
zeroElem
, Literal -> RuleM CoreExpr
identity Literal
oneI32
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Int32MulOp NumOps
int32Ops
]
PrimOp
Int32QuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, RuleM CoreExpr
leftZero
, Literal -> RuleM CoreExpr
rightIdentity Literal
oneI32
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
oneI32 ]
PrimOp
Int32RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI32
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI32 ]
PrimOp
Int32NegOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Int32NegOp ]
PrimOp
Int32SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt32 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI32 ]
PrimOp
Int32SraOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt32 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI32 ]
PrimOp
Int32SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt32 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word32
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI32 ]
PrimOp
Word32AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zeroW32
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Word32AddOp NumOps
word32Ops
]
PrimOp
Word32SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroW32
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW32
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Word32SubOp NumOps
word32Ops
]
PrimOp
Word32MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, Literal -> RuleM CoreExpr
identity Literal
oneW32
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Word32MulOp NumOps
word32Ops
]
PrimOp
Word32QuotOp-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, Literal -> RuleM CoreExpr
rightIdentity Literal
oneW32 ]
PrimOp
Word32RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW32
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW32 ]
PrimOp
Word32AndOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
, RuleM CoreExpr
idempotent
, RuleM CoreExpr
zeroElem
, Literal -> RuleM CoreExpr
identity (Integer -> Literal
mkLitWord32 Integer
0xFFFFFFFF)
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word32AndOp
, NumOps -> RuleM CoreExpr
andFoldingRules NumOps
word32Ops
]
PrimOp
Word32OrOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
, RuleM CoreExpr
idempotent
, Literal -> RuleM CoreExpr
identity Literal
zeroW32
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word32OrOp
, NumOps -> RuleM CoreExpr
orFoldingRules NumOps
word32Ops
]
PrimOp
Word32XorOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
, Literal -> RuleM CoreExpr
identity Literal
zeroW32
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW32 ]
PrimOp
Word32NotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Word32NotOp ]
PrimOp
Word32SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord32 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
PrimOp
Word32SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord32 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word32 ]
PrimOp
Int64AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zeroI64
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Int64AddOp NumOps
int64Ops
]
PrimOp
Int64SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI64
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI64
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Int64SubOp NumOps
int64Ops
]
PrimOp
Int64MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, RuleM CoreExpr
zeroElem
, Literal -> RuleM CoreExpr
identity Literal
oneI64
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Int64MulOp NumOps
int64Ops
]
PrimOp
Int64QuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, RuleM CoreExpr
leftZero
, Literal -> RuleM CoreExpr
rightIdentity Literal
oneI64
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
oneI64 ]
PrimOp
Int64RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI64
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroI64 ]
PrimOp
Int64NegOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Int64NegOp ]
PrimOp
Int64SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt64 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI64 ]
PrimOp
Int64SraOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt64 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI64 ]
PrimOp
Int64SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt64 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word64
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroI64 ]
PrimOp
Word64AddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zeroW64
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
Word64AddOp NumOps
word64Ops
]
PrimOp
Word64SubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zeroW64
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW64
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
Word64SubOp NumOps
word64Ops
]
PrimOp
Word64MulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, Literal -> RuleM CoreExpr
identity Literal
oneW64
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
Word64MulOp NumOps
word64Ops
]
PrimOp
Word64QuotOp-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, Literal -> RuleM CoreExpr
rightIdentity Literal
oneW64 ]
PrimOp
Word64RemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW64
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW64 ]
PrimOp
Word64AndOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
, RuleM CoreExpr
idempotent
, RuleM CoreExpr
zeroElem
, Literal -> RuleM CoreExpr
identity (Integer -> Literal
mkLitWord64 Integer
0xFFFFFFFFFFFFFFFF)
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word64AndOp
, NumOps -> RuleM CoreExpr
andFoldingRules NumOps
word64Ops
]
PrimOp
Word64OrOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
, RuleM CoreExpr
idempotent
, Literal -> RuleM CoreExpr
identity Literal
zeroW64
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
Word64OrOp
, NumOps -> RuleM CoreExpr
orFoldingRules NumOps
word64Ops
]
PrimOp
Word64XorOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
, Literal -> RuleM CoreExpr
identity Literal
zeroW64
, RuleM ()
equalArgs RuleM () -> CoreExpr -> RuleM CoreExpr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
zeroW64 ]
PrimOp
Word64NotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
Word64NotOp ]
PrimOp
Word64SllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord64 ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
PrimOp
Word64SrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord64 ((Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr)
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ (Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer)
-> (Integer -> ConTagZ -> Integer)
-> Platform
-> Integer
-> ConTagZ
-> Integer
forall a b. (a -> b) -> a -> b
$ forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word64 ]
PrimOp
IntAddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zeroi
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
IntAddOp NumOps
intOps
]
PrimOp
IntSubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 (-))
, (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi
, RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
IntSubOp NumOps
intOps
]
PrimOp
IntAddCOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, (Platform -> Literal) -> RuleM CoreExpr
identityCPlatform Platform -> Literal
zeroi ]
PrimOp
IntSubCOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 (-))
, (Platform -> Literal) -> RuleM CoreExpr
rightIdentityCPlatform Platform -> Literal
zeroi
, RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLitNoC Platform -> Literal
zeroi ]
PrimOp
IntMulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, RuleM CoreExpr
zeroElem
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
onei
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
IntMulOp NumOps
intOps
]
PrimOp
IntMul2Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ do
[Lit (LitNumber LitNumType
_ Integer
l1), Lit (LitNumber LitNumType
_ Integer
l2)] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
let r :: Integer
r = Integer
l1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
l2
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple
[ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (if Platform -> Integer -> Bool
platformInIntRange Platform
platform Integer
r then Platform -> Literal
zeroi Platform
platform else Platform -> Literal
onei Platform
platform)
, Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkIntLitWrap Platform
platform (Integer
r Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
`shiftR` Platform -> ConTagZ
platformWordSizeInBits Platform
platform)
, Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkIntLitWrap Platform
platform Integer
r
]
, RuleM CoreExpr
zeroElem RuleM CoreExpr -> (CoreExpr -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CoreExpr
z ->
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [CoreExpr
z,CoreExpr
z,CoreExpr
z])
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
onei RuleM CoreExpr -> (CoreExpr -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CoreExpr
other -> do
Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple
[ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)
, CoreExpr -> [CoreExpr] -> CoreExpr
mkCoreApps (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
IntSubOp))
[ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)
, CoreExpr -> [CoreExpr] -> CoreExpr
mkCoreApps (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
IntSrlOp))
[ CoreExpr
other
, Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkIntLit Platform
platform (ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Platform -> ConTagZ
platformWordSizeInBits Platform
platform ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
- ConTagZ
1))
]
]
, CoreExpr
other
]
]
PrimOp
IntQuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, RuleM CoreExpr
leftZero
, (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
onei
, RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
onei ]
PrimOp
IntRemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi
, RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi ]
PrimOp
IntAndOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
, RuleM CoreExpr
idempotent
, RuleM CoreExpr
zeroElem
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform (\Platform
p -> Platform -> Integer -> Literal
mkLitInt Platform
p (-Integer
1))
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
IntAndOp
, NumOps -> RuleM CoreExpr
andFoldingRules NumOps
intOps
]
PrimOp
IntOrOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
, RuleM CoreExpr
idempotent
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zeroi
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
IntOrOp
, NumOps -> RuleM CoreExpr
orFoldingRules NumOps
intOps
]
PrimOp
IntXorOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zeroi
, RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zeroi ]
PrimOp
IntNotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
IntNotOp ]
PrimOp
IntNegOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
IntNegOp ]
PrimOp
IntSllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL)
, (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi ]
PrimOp
IntSraOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR)
, (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi ]
PrimOp
IntSrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumInt Platform -> Integer -> ConTagZ -> Integer
shiftRightLogicalNative
, (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zeroi ]
PrimOp
WordAddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zerow
, PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
WordAddOp NumOps
wordOps
]
PrimOp
WordSubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 (-))
, (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
zerow
, RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow
, PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
WordSubOp NumOps
wordOps
]
PrimOp
WordAddCOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
, (Platform -> Literal) -> RuleM CoreExpr
identityCPlatform Platform -> Literal
zerow ]
PrimOp
WordSubCOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 (-))
, (Platform -> Literal) -> RuleM CoreExpr
rightIdentityCPlatform Platform -> Literal
zerow
, RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLitNoC Platform -> Literal
zerow ]
PrimOp
WordMulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
onew
, PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
WordMulOp NumOps
wordOps
]
PrimOp
WordQuotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
onew ]
PrimOp
WordRemOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, RuleM CoreExpr
leftZero
, ConTagZ -> RuleM ()
oneLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow
, RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow ]
PrimOp
WordAndOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))
, RuleM CoreExpr
idempotent
, RuleM CoreExpr
zeroElem
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform (\Platform
p -> Platform -> Integer -> Literal
mkLitWord Platform
p (Platform -> Integer
platformMaxWord Platform
p))
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
WordAndOp
, NumOps -> RuleM CoreExpr
andFoldingRules NumOps
wordOps
]
PrimOp
WordOrOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))
, RuleM CoreExpr
idempotent
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zerow
, PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
WordOrOp
, NumOps -> RuleM CoreExpr
orFoldingRules NumOps
wordOps
]
PrimOp
WordXorOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)
, (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
zerow
, RuleM ()
equalArgs RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
zerow ]
PrimOp
WordNotOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
complementOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
WordNotOp ]
PrimOp
WordSllOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord ((Integer -> ConTagZ -> Integer)
-> Platform -> Integer -> ConTagZ -> Integer
forall a b. a -> b -> a
const Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL) ]
PrimOp
WordSrlOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
LitNumWord Platform -> Integer -> ConTagZ -> Integer
shiftRightLogicalNative ]
PrimOp
PopCnt8Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word8 ]
PrimOp
PopCnt16Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word16 ]
PrimOp
PopCnt32Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word32 ]
PrimOp
PopCnt64Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word64 ]
PrimOp
PopCntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ RuleM PlatformWordSize
getWordSize RuleM PlatformWordSize
-> (PlatformWordSize -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
PlatformWordSize
PW4 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word32
PlatformWordSize
PW8 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count @Word64
]
PrimOp
Ctz8Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word8 ]
PrimOp
Ctz16Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word16 ]
PrimOp
Ctz32Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word32 ]
PrimOp
Ctz64Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word64 ]
PrimOp
CtzOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ RuleM PlatformWordSize
getWordSize RuleM PlatformWordSize
-> (PlatformWordSize -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
PlatformWordSize
PW4 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word32
PlatformWordSize
PW8 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz @Word64
]
PrimOp
Clz8Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word8 ]
PrimOp
Clz16Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word16 ]
PrimOp
Clz32Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word32 ]
PrimOp
Clz64Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word64 ]
PrimOp
ClzOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ RuleM PlatformWordSize
getWordSize RuleM PlatformWordSize
-> (PlatformWordSize -> RuleM CoreExpr) -> RuleM CoreExpr
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
PlatformWordSize
PW4 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word32
PlatformWordSize
PW8 -> forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz @Word64
]
PrimOp
Int8ToIntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToIntLit ]
PrimOp
Int16ToIntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToIntLit ]
PrimOp
Int32ToIntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToIntLit ]
PrimOp
Int64ToIntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToIntLit ]
PrimOp
IntToInt8Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowInt8Lit
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
IntToInt8Op ConTagZ
8 ]
PrimOp
IntToInt16Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowInt16Lit
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
IntToInt16Op ConTagZ
16 ]
PrimOp
IntToInt32Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowInt32Lit
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
IntToInt32Op ConTagZ
32 ]
PrimOp
IntToInt64Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowInt64Lit ]
PrimOp
Word8ToWordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToWordLit
, PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough PrimOp
WordToWord8Op Integer
0xFF
]
PrimOp
Word16ToWordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToWordLit
, PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough PrimOp
WordToWord16Op Integer
0xFFFF
]
PrimOp
Word32ToWordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToWordLit
, PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough PrimOp
WordToWord32Op Integer
0xFFFFFFFF
]
PrimOp
Word64ToWordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
convertToWordLit ]
PrimOp
WordToWord8Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowWord8Lit
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
WordToWord8Op ConTagZ
8 ]
PrimOp
WordToWord16Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowWord16Lit
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
WordToWord16Op ConTagZ
16 ]
PrimOp
WordToWord32Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowWord32Lit
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
WordToWord32Op ConTagZ
32 ]
PrimOp
WordToWord64Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
narrowWord64Lit ]
PrimOp
Word8ToInt8Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt8) ]
PrimOp
Int8ToWord8Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord8) ]
PrimOp
Word16ToInt16Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt16) ]
PrimOp
Int16ToWord16Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord16) ]
PrimOp
Word32ToInt32Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt32) ]
PrimOp
Int32ToWord32Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord32) ]
PrimOp
Word64ToInt64Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt64) ]
PrimOp
Int64ToWord64Op-> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord64) ]
PrimOp
WordToIntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumInt) ]
PrimOp
IntToWordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
LitNumWord) ]
PrimOp
Narrow8IntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumInt8)
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8IntOp
, PrimOp
Narrow8IntOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow16IntOp
, PrimOp
Narrow8IntOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow32IntOp
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
Narrow8IntOp ConTagZ
8 ]
PrimOp
Narrow16IntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumInt16)
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8IntOp
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow16IntOp
, PrimOp
Narrow16IntOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow32IntOp
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
Narrow16IntOp ConTagZ
16 ]
PrimOp
Narrow32IntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumInt32)
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8IntOp
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow16IntOp
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow32IntOp
, RuleM CoreExpr
removeOp32
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
IntAndOp PrimOp
Narrow32IntOp ConTagZ
32 ]
PrimOp
Narrow8WordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumWord8)
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8WordOp
, PrimOp
Narrow8WordOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow16WordOp
, PrimOp
Narrow8WordOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow32WordOp
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
Narrow8WordOp ConTagZ
8 ]
PrimOp
Narrow16WordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumWord16)
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8WordOp
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow16WordOp
, PrimOp
Narrow16WordOp PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
Narrow32WordOp
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
Narrow16WordOp ConTagZ
16 ]
PrimOp
Narrow32WordOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform (LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
LitNumWord32)
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow8WordOp
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow16WordOp
, PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
Narrow32WordOp
, RuleM CoreExpr
removeOp32
, PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
WordAndOp PrimOp
Narrow32WordOp ConTagZ
32 ]
PrimOp
OrdOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
charToIntLit
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
ChrOp ]
PrimOp
ChrOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ do [Lit Literal
lit] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Literal -> Bool
litFitsInChar Literal
lit)
(Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
intToCharLit
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
OrdOp ]
PrimOp
FloatToIntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
floatToIntLit ]
PrimOp
IntToFloatOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
intToFloatLit ]
PrimOp
DoubleToIntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
doubleToIntLit ]
PrimOp
IntToDoubleOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
intToDoubleLit ]
PrimOp
FloatToDoubleOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
floatToDoubleLit ]
PrimOp
DoubleToFloatOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
doubleToFloatLit ]
PrimOp
FloatAddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zerof ]
PrimOp
FloatSubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zerof ]
PrimOp
FloatMulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*))
, Literal -> RuleM CoreExpr
identity Literal
onef
, Literal -> PrimOp -> RuleM CoreExpr
strengthReduction Literal
twof PrimOp
FloatAddOp ]
PrimOp
FloatDivOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ RuleM ()
guardFloatDiv RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(/))
, Literal -> RuleM CoreExpr
rightIdentity Literal
onef ]
PrimOp
FloatNegOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
FloatNegOp ]
PrimOp
FloatDecode_IntOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
floatDecodeOp ]
PrimOp
DoubleAddOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+))
, Literal -> RuleM CoreExpr
identity Literal
zerod ]
PrimOp
DoubleSubOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 (-))
, Literal -> RuleM CoreExpr
rightIdentity Literal
zerod ]
PrimOp
DoubleMulOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*))
, Literal -> RuleM CoreExpr
identity Literal
oned
, Literal -> PrimOp -> RuleM CoreExpr
strengthReduction Literal
twod PrimOp
DoubleAddOp ]
PrimOp
DoubleDivOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [ RuleM ()
guardDoubleDiv RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(/))
, Literal -> RuleM CoreExpr
rightIdentity Literal
oned ]
PrimOp
DoubleNegOp -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
negOp
, PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
DoubleNegOp ]
PrimOp
DoubleDecode_Int64Op -> Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
1 [ (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit RuleOpts -> Literal -> Maybe CoreExpr
doubleDecodeOp ]
PrimOp
Int8EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
Int8NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
Int16EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
Int16NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
Int32EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
Int32NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
Int64EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
Int64NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
IntEqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
IntNeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
Word8EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
Word8NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
Word16EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
Word16NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
Word32EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
Word32NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
Word64EqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
Word64NeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
WordEqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
WordNeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
CharEqOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==) [ Bool -> RuleM CoreExpr
litEq Bool
True ]
PrimOp
CharNeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=) [ Bool -> RuleM CoreExpr
litEq Bool
False ]
PrimOp
FloatEqOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==)
PrimOp
FloatNeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=)
PrimOp
DoubleEqOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(==)
PrimOp
DoubleNeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(/=)
PrimOp
Int8GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
Int8GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
Int8LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
Int8LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
Int16GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
Int16GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
Int16LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
Int16LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
Int32GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
Int32GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
Int32LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
Int32LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
Int64GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
Int64GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
Int64LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
Int64LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
IntGtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
IntGeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
IntLeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
IntLtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
Word8GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
Word8GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
Word8LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
Word8LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
Word16GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
Word16GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
Word16LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
Word16LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
Word32GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
Word32GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
Word32LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
Word32LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
Word64GtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
Word64GeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
Word64LeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
Word64LtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
WordGtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
WordGeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
WordLeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
WordLtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
CharGtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Gt ]
PrimOp
CharGeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Ge ]
PrimOp
CharLeOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Le ]
PrimOp
CharLtOp -> Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) [ Comparison -> RuleM CoreExpr
boundsCmp Comparison
Lt ]
PrimOp
FloatGtOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
PrimOp
FloatGeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
PrimOp
FloatLeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
PrimOp
FloatLtOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)
PrimOp
DoubleGtOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
PrimOp
DoubleGeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
PrimOp
DoubleLeOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
PrimOp
DoubleLtOp -> Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)
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
mkPrimOpRule :: Name -> Int -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule :: Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
arity [RuleM CoreExpr]
rules = CoreRule -> Maybe CoreRule
forall a. a -> Maybe a
Just (CoreRule -> Maybe CoreRule) -> CoreRule -> Maybe CoreRule
forall a b. (a -> b) -> a -> b
$ Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkBasicRule Name
nm ConTagZ
arity ([RuleM CoreExpr] -> RuleM CoreExpr
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [RuleM CoreExpr]
rules)
mkRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)
-> [RuleM CoreExpr] -> Maybe CoreRule
mkRelOpRule :: Name
-> (forall a. Ord a => a -> a -> Bool)
-> [RuleM CoreExpr]
-> Maybe CoreRule
mkRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
cmp [RuleM CoreExpr]
extra
= Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 ([RuleM CoreExpr] -> Maybe CoreRule)
-> [RuleM CoreExpr] -> Maybe CoreRule
forall a b. (a -> b) -> a -> b
$
(forall a. Ord a => a -> a -> Bool) -> RuleM CoreExpr
binaryCmpLit a -> a -> Bool
forall a. Ord a => a -> a -> Bool
cmp RuleM CoreExpr -> [RuleM CoreExpr] -> [RuleM CoreExpr]
forall a. a -> [a] -> [a]
: RuleM CoreExpr
equal_rule RuleM CoreExpr -> [RuleM CoreExpr] -> [RuleM CoreExpr]
forall a. a -> [a] -> [a]
: [RuleM CoreExpr]
extra
where
equal_rule :: RuleM CoreExpr
equal_rule = do { RuleM ()
equalArgs
; Platform
platform <- RuleM Platform
getPlatform
; CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
cmp Bool
True Bool
True
then Platform -> CoreExpr
trueValInt Platform
platform
else Platform -> CoreExpr
falseValInt Platform
platform) }
mkFloatingRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)
-> Maybe CoreRule
mkFloatingRelOpRule :: Name -> (forall a. Ord a => a -> a -> Bool) -> Maybe CoreRule
mkFloatingRelOpRule Name
nm forall a. Ord a => a -> a -> Bool
cmp
= Name -> ConTagZ -> [RuleM CoreExpr] -> Maybe CoreRule
mkPrimOpRule Name
nm ConTagZ
2 [(forall a. Ord a => a -> a -> Bool) -> RuleM CoreExpr
binaryCmpLit a -> a -> Bool
forall a. Ord a => a -> a -> Bool
cmp]
zeroi, onei, zerow, onew :: Platform -> Literal
zeroi :: Platform -> Literal
zeroi Platform
platform = Platform -> Integer -> Literal
mkLitInt Platform
platform Integer
0
onei :: Platform -> Literal
onei Platform
platform = Platform -> Integer -> Literal
mkLitInt Platform
platform Integer
1
zerow :: Platform -> Literal
zerow Platform
platform = Platform -> Integer -> Literal
mkLitWord Platform
platform Integer
0
onew :: Platform -> Literal
onew Platform
platform = Platform -> Integer -> Literal
mkLitWord Platform
platform Integer
1
zeroI8, oneI8, zeroW8, oneW8 :: Literal
zeroI8 :: Literal
zeroI8 = Integer -> Literal
mkLitInt8 Integer
0
oneI8 :: Literal
oneI8 = Integer -> Literal
mkLitInt8 Integer
1
zeroW8 :: Literal
zeroW8 = Integer -> Literal
mkLitWord8 Integer
0
oneW8 :: Literal
oneW8 = Integer -> Literal
mkLitWord8 Integer
1
zeroI16, oneI16, zeroW16, oneW16 :: Literal
zeroI16 :: Literal
zeroI16 = Integer -> Literal
mkLitInt16 Integer
0
oneI16 :: Literal
oneI16 = Integer -> Literal
mkLitInt16 Integer
1
zeroW16 :: Literal
zeroW16 = Integer -> Literal
mkLitWord16 Integer
0
oneW16 :: Literal
oneW16 = Integer -> Literal
mkLitWord16 Integer
1
zeroI32, oneI32, zeroW32, oneW32 :: Literal
zeroI32 :: Literal
zeroI32 = Integer -> Literal
mkLitInt32 Integer
0
oneI32 :: Literal
oneI32 = Integer -> Literal
mkLitInt32 Integer
1
zeroW32 :: Literal
zeroW32 = Integer -> Literal
mkLitWord32 Integer
0
oneW32 :: Literal
oneW32 = Integer -> Literal
mkLitWord32 Integer
1
zeroI64, oneI64, zeroW64, oneW64 :: Literal
zeroI64 :: Literal
zeroI64 = Integer -> Literal
mkLitInt64 Integer
0
oneI64 :: Literal
oneI64 = Integer -> Literal
mkLitInt64 Integer
1
zeroW64 :: Literal
zeroW64 = Integer -> Literal
mkLitWord64 Integer
0
oneW64 :: Literal
oneW64 = Integer -> Literal
mkLitWord64 Integer
1
zerof, onef, twof, zerod, oned, twod :: Literal
zerof :: Literal
zerof = Rational -> Literal
mkLitFloat Rational
0.0
onef :: Literal
onef = Rational -> Literal
mkLitFloat Rational
1.0
twof :: Literal
twof = Rational -> Literal
mkLitFloat Rational
2.0
zerod :: Literal
zerod = Rational -> Literal
mkLitDouble Rational
0.0
oned :: Literal
oned = Rational -> Literal
mkLitDouble Rational
1.0
twod :: Literal
twod = Rational -> Literal
mkLitDouble Rational
2.0
cmpOp :: Platform -> (forall a . Ord a => a -> a -> Bool)
-> Literal -> Literal -> Maybe CoreExpr
cmpOp :: Platform
-> (forall a. Ord a => a -> a -> Bool)
-> Literal
-> Literal
-> Maybe CoreExpr
cmpOp Platform
platform forall a. Ord a => a -> a -> Bool
cmp = Literal -> Literal -> Maybe CoreExpr
go
where
done :: Bool -> Maybe CoreExpr
done Bool
True = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
trueValInt Platform
platform
done Bool
False = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CoreExpr
falseValInt Platform
platform
go :: Literal -> Literal -> Maybe CoreExpr
go (LitChar Char
i1) (LitChar Char
i2) = Bool -> Maybe CoreExpr
done (Char
i1 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
`cmp` Char
i2)
go (LitFloat Rational
i1) (LitFloat Rational
i2) = Bool -> Maybe CoreExpr
done (Rational
i1 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
`cmp` Rational
i2)
go (LitDouble Rational
i1) (LitDouble Rational
i2) = Bool -> Maybe CoreExpr
done (Rational
i1 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
`cmp` Rational
i2)
go (LitNumber LitNumType
nt1 Integer
i1) (LitNumber LitNumType
nt2 Integer
i2)
| LitNumType
nt1 LitNumType -> LitNumType -> Bool
forall a. Eq a => a -> a -> Bool
/= LitNumType
nt2 = Maybe CoreExpr
forall a. Maybe a
Nothing
| Bool
otherwise = Bool -> Maybe CoreExpr
done (Integer
i1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
`cmp` Integer
i2)
go Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
negOp :: RuleOpts -> Literal -> Maybe CoreExpr
negOp :: RuleOpts -> Literal -> Maybe CoreExpr
negOp RuleOpts
env = \case
(LitFloat Rational
0.0) -> Maybe CoreExpr
forall a. Maybe a
Nothing
(LitFloat Rational
f) -> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (RuleOpts -> Rational -> CoreExpr
mkFloatVal RuleOpts
env (-Rational
f))
(LitDouble Rational
0.0) -> Maybe CoreExpr
forall a. Maybe a
Nothing
(LitDouble Rational
d) -> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (RuleOpts -> Rational -> CoreExpr
mkDoubleVal RuleOpts
env (-Rational
d))
(LitNumber LitNumType
nt Integer
i)
| LitNumType -> Bool
litNumIsSigned LitNumType
nt -> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap (RuleOpts -> Platform
roPlatform RuleOpts
env) LitNumType
nt (-Integer
i)))
Literal
_ -> Maybe CoreExpr
forall a. Maybe a
Nothing
complementOp :: RuleOpts -> Literal -> Maybe CoreExpr
complementOp :: RuleOpts -> Literal -> Maybe CoreExpr
complementOp RuleOpts
env (LitNumber LitNumType
nt Integer
i) =
CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap (RuleOpts -> Platform
roPlatform RuleOpts
env) LitNumType
nt (Integer -> Integer
forall a. Bits a => a -> a
complement Integer
i)))
complementOp RuleOpts
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
int8Op2
:: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int8Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumInt8 Integer
i1) (LitNumber LitNumType
LitNumInt8 Integer
i2) =
Integer -> Maybe CoreExpr
int8Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
int8Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
int16Op2
:: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int16Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumInt16 Integer
i1) (LitNumber LitNumType
LitNumInt16 Integer
i2) =
Integer -> Maybe CoreExpr
int16Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
int16Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
int32Op2
:: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int32Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumInt32 Integer
i1) (LitNumber LitNumType
LitNumInt32 Integer
i2) =
Integer -> Maybe CoreExpr
int32Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
int32Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
int64Op2
:: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
int64Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumInt64 Integer
i1) (LitNumber LitNumType
LitNumInt64 Integer
i2) =
Integer -> Maybe CoreExpr
int64Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
int64Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
intOp2 :: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 = (RuleOpts -> a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(RuleOpts -> a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2' ((RuleOpts -> a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> ((a -> b -> Integer) -> RuleOpts -> a -> b -> Integer)
-> (a -> b -> Integer)
-> RuleOpts
-> Literal
-> Literal
-> Maybe CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> Integer) -> RuleOpts -> a -> b -> Integer
forall a b. a -> b -> a
const
intOp2' :: (Integral a, Integral b)
=> (RuleOpts -> a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2' :: forall a b.
(Integral a, Integral b) =>
(RuleOpts -> a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2' RuleOpts -> a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumInt Integer
i1) (LitNumber LitNumType
LitNumInt Integer
i2) =
let o :: a -> b -> Integer
o = RuleOpts -> a -> b -> Integer
op RuleOpts
env
in Platform -> Integer -> Maybe CoreExpr
intResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`o` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
intOp2' RuleOpts -> a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
intOpC2 :: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOpC2 a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumInt Integer
i1) (LitNumber LitNumType
LitNumInt Integer
i2) =
Platform -> Integer -> Maybe CoreExpr
intCResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
intOpC2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
shiftRightLogical :: forall t. (Integral t, Bits t) => Integer -> Int -> Integer
shiftRightLogical :: forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical Integer
x ConTagZ
n = t -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> t
forall a. Num a => Integer -> a
fromInteger Integer
x t -> ConTagZ -> t
forall a. Bits a => a -> ConTagZ -> a
`shiftR` ConTagZ
n :: t)
shiftRightLogicalNative :: Platform -> Integer -> Int -> Integer
shiftRightLogicalNative :: Platform -> Integer -> ConTagZ -> Integer
shiftRightLogicalNative Platform
platform =
case Platform -> PlatformWordSize
platformWordSize Platform
platform of
PlatformWordSize
PW4 -> forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word32
PlatformWordSize
PW8 -> forall t. (Integral t, Bits t) => Integer -> ConTagZ -> Integer
shiftRightLogical @Word64
retLit :: (Platform -> Literal) -> RuleM CoreExpr
retLit :: (Platform -> Literal) -> RuleM CoreExpr
retLit Platform -> Literal
l = do Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> Literal
l Platform
platform
retLitNoC :: (Platform -> Literal) -> RuleM CoreExpr
retLitNoC :: (Platform -> Literal) -> RuleM CoreExpr
retLitNoC Platform -> Literal
l = do Platform
platform <- RuleM Platform
getPlatform
let lit :: Literal
lit = Platform -> Literal
l Platform
platform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit, Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)]
word8Op2
:: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word8Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumWord8 Integer
i1) (LitNumber LitNumType
LitNumWord8 Integer
i2) =
Integer -> Maybe CoreExpr
word8Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
word8Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
word16Op2
:: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word16Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumWord16 Integer
i1) (LitNumber LitNumType
LitNumWord16 Integer
i2) =
Integer -> Maybe CoreExpr
word16Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
word16Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
word32Op2
:: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word32Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumWord32 Integer
i1) (LitNumber LitNumType
LitNumWord32 Integer
i2) =
Integer -> Maybe CoreExpr
word32Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
word32Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
word64Op2
:: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
word64Op2 a -> b -> Integer
op RuleOpts
_ (LitNumber LitNumType
LitNumWord64 Integer
i1) (LitNumber LitNumType
LitNumWord64 Integer
i2) =
Integer -> Maybe CoreExpr
word64Result (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i2)
word64Op2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
wordOp2 :: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOp2 a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumWord Integer
w1) (LitNumber LitNumType
LitNumWord Integer
w2)
= Platform -> Integer -> Maybe CoreExpr
wordResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
w1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
w2)
wordOp2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
wordOpC2 :: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 :: forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
wordOpC2 a -> b -> Integer
op RuleOpts
env (LitNumber LitNumType
LitNumWord Integer
w1) (LitNumber LitNumType
LitNumWord Integer
w2) =
Platform -> Integer -> Maybe CoreExpr
wordCResult (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
w1 a -> b -> Integer
`op` Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
w2)
wordOpC2 a -> b -> Integer
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
shiftRule :: LitNumType
-> (Platform -> Integer -> Int -> Integer)
-> RuleM CoreExpr
shiftRule :: LitNumType
-> (Platform -> Integer -> ConTagZ -> Integer) -> RuleM CoreExpr
shiftRule LitNumType
lit_num_ty Platform -> Integer -> ConTagZ -> Integer
shift_op = do
Platform
platform <- RuleM Platform
getPlatform
[CoreExpr
e1, Lit (LitNumber LitNumType
LitNumInt Integer
shift_len)] <- RuleM [CoreExpr]
getArgs
Integer
bit_size <- case Platform -> LitNumType -> Maybe Word
litNumBitSize Platform
platform LitNumType
lit_num_ty of
Maybe Word
Nothing -> RuleM Integer
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Word
bs -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
bs)
case CoreExpr
e1 of
CoreExpr
_ | Integer
shift_len Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoreExpr
e1
CoreExpr
_ | Integer
shift_len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
shift_len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
bit_size
-> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
lit_num_ty Integer
0
Lit (LitNumber LitNumType
nt Integer
x)
| Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
shift_len Bool -> Bool -> Bool
&& Integer
shift_len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
bit_size
-> Bool -> RuleM CoreExpr -> RuleM CoreExpr
forall a. HasCallStack => Bool -> a -> a
assert (LitNumType
nt LitNumType -> LitNumType -> Bool
forall a. Eq a => a -> a -> Bool
== LitNumType
lit_num_ty) (RuleM CoreExpr -> RuleM CoreExpr)
-> RuleM CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$
let op :: Integer -> ConTagZ -> Integer
op = Platform -> Integer -> ConTagZ -> Integer
shift_op Platform
platform
y :: Integer
y = Integer
x Integer -> ConTagZ -> Integer
`op` Integer -> ConTagZ
forall a. Num a => Integer -> a
fromInteger Integer
shift_len
in CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
nt Integer
y
CoreExpr
_ -> RuleM CoreExpr
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
floatOp2 :: (Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal
-> Maybe (Expr CoreBndr)
floatOp2 :: (Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
floatOp2 Rational -> Rational -> Rational
op RuleOpts
env (LitFloat Rational
f1) (LitFloat Rational
f2)
= CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (RuleOpts -> Rational -> CoreExpr
mkFloatVal RuleOpts
env (Rational
f1 Rational -> Rational -> Rational
`op` Rational
f2))
floatOp2 Rational -> Rational -> Rational
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
floatDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr
floatDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr
floatDecodeOp RuleOpts
env (LitFloat ((Float -> (Integer, ConTagZ)
forall a. RealFloat a => a -> (Integer, ConTagZ)
decodeFloat (Float -> (Integer, ConTagZ))
-> (Rational -> Float) -> Rational -> (Integer, ConTagZ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational @Float) -> (Integer
m, ConTagZ
e)))
= CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [ Platform -> Integer -> CoreExpr
mkIntVal (RuleOpts -> Platform
roPlatform RuleOpts
env) (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
m)
, Platform -> Integer -> CoreExpr
mkIntVal (RuleOpts -> Platform
roPlatform RuleOpts
env) (ConTagZ -> Integer
forall a. Integral a => a -> Integer
toInteger ConTagZ
e) ]
floatDecodeOp RuleOpts
_ Literal
_
= Maybe CoreExpr
forall a. Maybe a
Nothing
doubleOp2 :: (Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal
-> Maybe (Expr CoreBndr)
doubleOp2 :: (Rational -> Rational -> Rational)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
doubleOp2 Rational -> Rational -> Rational
op RuleOpts
env (LitDouble Rational
f1) (LitDouble Rational
f2)
= CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (RuleOpts -> Rational -> CoreExpr
mkDoubleVal RuleOpts
env (Rational
f1 Rational -> Rational -> Rational
`op` Rational
f2))
doubleOp2 Rational -> Rational -> Rational
_ RuleOpts
_ Literal
_ Literal
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr
doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr
doubleDecodeOp RuleOpts
env (LitDouble ((Double -> (Integer, ConTagZ)
forall a. RealFloat a => a -> (Integer, ConTagZ)
decodeFloat (Double -> (Integer, ConTagZ))
-> (Rational -> Double) -> Rational -> (Integer, ConTagZ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational @Double) -> (Integer
m, ConTagZ
e)))
= CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitINT64 (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
m))
, Platform -> Integer -> CoreExpr
mkIntVal Platform
platform (ConTagZ -> Integer
forall a. Integral a => a -> Integer
toInteger ConTagZ
e) ]
where
platform :: Platform
platform = RuleOpts -> Platform
roPlatform RuleOpts
env
mkLitINT64 :: Integer -> Literal
mkLitINT64 | Platform -> ConTagZ
platformWordSizeInBits Platform
platform ConTagZ -> ConTagZ -> Bool
forall a. Ord a => a -> a -> Bool
< ConTagZ
64
= Integer -> Literal
mkLitInt64Wrap
| Bool
otherwise
= Platform -> Integer -> Literal
mkLitIntWrap Platform
platform
doubleDecodeOp RuleOpts
_ Literal
_
= Maybe CoreExpr
forall a. Maybe a
Nothing
litEq :: Bool
-> RuleM CoreExpr
litEq :: Bool -> RuleM CoreExpr
litEq Bool
is_eq = [RuleM CoreExpr] -> RuleM CoreExpr
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
[ do [Lit Literal
lit, CoreExpr
expr] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Platform -> Literal -> CoreExpr -> RuleM CoreExpr
do_lit_eq Platform
platform Literal
lit CoreExpr
expr
, do [CoreExpr
expr, Lit Literal
lit] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Platform -> Literal -> CoreExpr -> RuleM CoreExpr
do_lit_eq Platform
platform Literal
lit CoreExpr
expr ]
where
do_lit_eq :: Platform -> Literal -> CoreExpr -> RuleM CoreExpr
do_lit_eq Platform
platform Literal
lit CoreExpr
expr = do
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Literal -> Bool
litIsLifted Literal
lit))
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Scaled Type -> Type -> [CoreAlt] -> CoreExpr
mkWildCase CoreExpr
expr (Type -> Scaled Type
forall a. a -> Scaled a
unrestricted (Type -> Scaled Type) -> Type -> Scaled Type
forall a b. (a -> b) -> a -> b
$ Literal -> Type
literalType Literal
lit) Type
intPrimTy
[ AltCon -> [Id] -> CoreExpr -> CoreAlt
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
DEFAULT [] CoreExpr
val_if_neq
, AltCon -> [Id] -> CoreExpr -> CoreAlt
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt (Literal -> AltCon
LitAlt Literal
lit) [] CoreExpr
val_if_eq])
where
val_if_eq :: CoreExpr
val_if_eq | Bool
is_eq = Platform -> CoreExpr
trueValInt Platform
platform
| Bool
otherwise = Platform -> CoreExpr
falseValInt Platform
platform
val_if_neq :: CoreExpr
val_if_neq | Bool
is_eq = Platform -> CoreExpr
falseValInt Platform
platform
| Bool
otherwise = Platform -> CoreExpr
trueValInt Platform
platform
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
int8Result :: Integer -> Maybe CoreExpr
int8Result :: Integer -> Maybe CoreExpr
int8Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
int8Result' Integer
result)
int8Result' :: Integer -> CoreExpr
int8Result' :: Integer -> CoreExpr
int8Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt8Wrap Integer
result)
int16Result :: Integer -> Maybe CoreExpr
int16Result :: Integer -> Maybe CoreExpr
int16Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
int16Result' Integer
result)
int16Result' :: Integer -> CoreExpr
int16Result' :: Integer -> CoreExpr
int16Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt16Wrap Integer
result)
int32Result :: Integer -> Maybe CoreExpr
int32Result :: Integer -> Maybe CoreExpr
int32Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
int32Result' Integer
result)
int32Result' :: Integer -> CoreExpr
int32Result' :: Integer -> CoreExpr
int32Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt32Wrap Integer
result)
intResult :: Platform -> Integer -> Maybe CoreExpr
intResult :: Platform -> Integer -> Maybe CoreExpr
intResult Platform
platform Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Platform -> Integer -> CoreExpr
intResult' Platform
platform Integer
result)
intResult' :: Platform -> Integer -> CoreExpr
intResult' :: Platform -> Integer -> CoreExpr
intResult' Platform
platform Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitIntWrap Platform
platform Integer
result)
intCResult :: Platform -> Integer -> Maybe CoreExpr
intCResult :: Platform -> Integer -> Maybe CoreExpr
intCResult Platform
platform Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just ([CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit, Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
c])
where
(Literal
lit, Bool
b) = Platform -> Integer -> (Literal, Bool)
mkLitIntWrapC Platform
platform Integer
result
c :: Literal
c = if Bool
b then Platform -> Literal
onei Platform
platform else Platform -> Literal
zeroi Platform
platform
word8Result :: Integer -> Maybe CoreExpr
word8Result :: Integer -> Maybe CoreExpr
word8Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
word8Result' Integer
result)
word8Result' :: Integer -> CoreExpr
word8Result' :: Integer -> CoreExpr
word8Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord8Wrap Integer
result)
word16Result :: Integer -> Maybe CoreExpr
word16Result :: Integer -> Maybe CoreExpr
word16Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
word16Result' Integer
result)
word16Result' :: Integer -> CoreExpr
word16Result' :: Integer -> CoreExpr
word16Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord16Wrap Integer
result)
word32Result :: Integer -> Maybe CoreExpr
word32Result :: Integer -> Maybe CoreExpr
word32Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
word32Result' Integer
result)
word32Result' :: Integer -> CoreExpr
word32Result' :: Integer -> CoreExpr
word32Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord32Wrap Integer
result)
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)
wordCResult :: Platform -> Integer -> Maybe CoreExpr
wordCResult :: Platform -> Integer -> Maybe CoreExpr
wordCResult Platform
platform Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just ([CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit, Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
c])
where
(Literal
lit, Bool
b) = Platform -> Integer -> (Literal, Bool)
mkLitWordWrapC Platform
platform Integer
result
c :: Literal
c = if Bool
b then Platform -> Literal
onei Platform
platform else Platform -> Literal
zeroi Platform
platform
int64Result :: Integer -> Maybe CoreExpr
int64Result :: Integer -> Maybe CoreExpr
int64Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
int64Result' Integer
result)
int64Result' :: Integer -> CoreExpr
int64Result' :: Integer -> CoreExpr
int64Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt64Wrap Integer
result)
word64Result :: Integer -> Maybe CoreExpr
word64Result :: Integer -> Maybe CoreExpr
word64Result Integer
result = CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
word64Result' Integer
result)
word64Result' :: Integer -> CoreExpr
word64Result' :: Integer -> CoreExpr
word64Result' Integer
result = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord64Wrap Integer
result)
semiInversePrimOp :: PrimOp -> RuleM CoreExpr
semiInversePrimOp :: PrimOp -> RuleM CoreExpr
semiInversePrimOp PrimOp
primop = do
[Var Id
primop_id `App` CoreExpr
e] <- RuleM [CoreExpr]
getArgs
PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
primop Id
primop_id
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e
subsumesPrimOp :: PrimOp -> PrimOp -> RuleM CoreExpr
PrimOp
this subsumesPrimOp :: PrimOp -> PrimOp -> RuleM CoreExpr
`subsumesPrimOp` PrimOp
that = do
[Var Id
primop_id `App` CoreExpr
e] <- RuleM [CoreExpr]
getArgs
PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
that Id
primop_id
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
this) CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
e)
subsumedByPrimOp :: PrimOp -> RuleM CoreExpr
subsumedByPrimOp :: PrimOp -> RuleM CoreExpr
subsumedByPrimOp PrimOp
primop = do
[e :: CoreExpr
e@(Var Id
primop_id `App` CoreExpr
_)] <- RuleM [CoreExpr]
getArgs
PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
primop Id
primop_id
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e
extendNarrowPassthrough :: PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough :: PrimOp -> Integer -> RuleM CoreExpr
extendNarrowPassthrough PrimOp
narrow_primop Integer
n = do
[Var Id
primop_id `App` CoreExpr
x] <- RuleM [CoreExpr]
getArgs
PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
narrow_primop Id
primop_id
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
WordAndOp) CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumWord Integer
n))
narrowSubsumesAnd :: PrimOp -> PrimOp -> Int -> RuleM CoreExpr
narrowSubsumesAnd :: PrimOp -> PrimOp -> ConTagZ -> RuleM CoreExpr
narrowSubsumesAnd PrimOp
and_primop PrimOp
narrw ConTagZ
n = do
[Var Id
primop_id `App` CoreExpr
x `App` CoreExpr
y] <- RuleM [CoreExpr]
getArgs
PrimOp -> Id -> RuleM ()
matchPrimOpId PrimOp
and_primop Id
primop_id
let mask :: Integer
mask = ConTagZ -> Integer
forall a. Bits a => ConTagZ -> a
bit ConTagZ
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1
g :: CoreExpr -> CoreExpr -> RuleM CoreExpr
g CoreExpr
v (Lit (LitNumber LitNumType
_ Integer
m)) = do
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
m Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
mask)
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
narrw) CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
v)
g CoreExpr
_ CoreExpr
_ = RuleM CoreExpr
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
CoreExpr -> CoreExpr -> RuleM CoreExpr
g CoreExpr
x CoreExpr
y RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
forall a. RuleM a -> RuleM a -> RuleM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CoreExpr -> CoreExpr -> RuleM CoreExpr
g CoreExpr
y CoreExpr
x
idempotent :: RuleM CoreExpr
idempotent :: RuleM CoreExpr
idempotent = do [CoreExpr
e1, CoreExpr
e2] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e1 CoreExpr
e2
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1
sameArgIdempotentCommut :: PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut :: PrimOp -> RuleM CoreExpr
sameArgIdempotentCommut PrimOp
op = do
[CoreExpr
a,CoreExpr
b] <- RuleM [CoreExpr]
getArgs
case (CoreExpr
a,CoreExpr
b) of
(PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop PrimOp
op -> Just (CoreExpr
e1,CoreExpr
e2), CoreExpr
e3)
| CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e2 CoreExpr
e3 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
a
| CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e1 CoreExpr
e3 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
a
(CoreExpr
e3, PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop PrimOp
op -> Just (CoreExpr
e1,CoreExpr
e2))
| CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e2 CoreExpr
e3 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
b
| CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
cheapEqExpr CoreExpr
e1 CoreExpr
e3 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
b
(CoreExpr, CoreExpr)
_ -> RuleM CoreExpr
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
mkBasicRule :: Name -> Int -> RuleM CoreExpr -> CoreRule
mkBasicRule :: Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkBasicRule Name
op_name ConTagZ
n_args RuleM CoreExpr
rm
= BuiltinRule { ru_name :: RuleName
ru_name = OccName -> RuleName
occNameFS (Name -> OccName
nameOccName Name
op_name),
ru_fn :: Name
ru_fn = Name
op_name,
ru_nargs :: ConTagZ
ru_nargs = ConTagZ
n_args,
ru_try :: RuleFun
ru_try = RuleM CoreExpr -> RuleFun
forall r.
RuleM r -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r
runRuleM RuleM CoreExpr
rm }
newtype RuleM r = RuleM
{ forall r.
RuleM r -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r
runRuleM :: RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r }
deriving ((forall a b. (a -> b) -> RuleM a -> RuleM b)
-> (forall a b. a -> RuleM b -> RuleM a) -> Functor RuleM
forall a b. a -> RuleM b -> RuleM a
forall a b. (a -> b) -> RuleM a -> RuleM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RuleM a -> RuleM b
fmap :: forall a b. (a -> b) -> RuleM a -> RuleM b
$c<$ :: forall a b. a -> RuleM b -> RuleM a
<$ :: forall a b. a -> RuleM b -> RuleM a
Functor)
instance Applicative RuleM where
pure :: forall a. a -> RuleM a
pure a
x = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a) -> RuleM a
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a)
-> RuleM a)
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a)
-> RuleM a
forall a b. (a -> b) -> a -> b
$ \RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
<*> :: forall a b. RuleM (a -> b) -> RuleM a -> RuleM b
(<*>) = RuleM (a -> b) -> RuleM a -> RuleM b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad RuleM where
RuleM RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
f >>= :: forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
>>= a -> RuleM b
g
= (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe b) -> RuleM b
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe b)
-> RuleM b)
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe b)
-> RuleM b
forall a b. (a -> b) -> a -> b
$ \RuleOpts
env InScopeEnv
iu Id
fn [CoreExpr]
args ->
case RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
f RuleOpts
env InScopeEnv
iu Id
fn [CoreExpr]
args of
Maybe a
Nothing -> Maybe b
forall a. Maybe a
Nothing
Just a
r -> RuleM b -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe b
forall r.
RuleM r -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r
runRuleM (a -> RuleM b
g a
r) RuleOpts
env InScopeEnv
iu Id
fn [CoreExpr]
args
instance MonadFail RuleM where
fail :: forall a. String -> RuleM a
fail String
_ = RuleM a
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance Alternative RuleM where
empty :: forall a. RuleM a
empty = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a) -> RuleM a
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a)
-> RuleM a)
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a)
-> RuleM a
forall a b. (a -> b) -> a -> b
$ \RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ -> Maybe a
forall a. Maybe a
Nothing
RuleM RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
f1 <|> :: forall a. RuleM a -> RuleM a -> RuleM a
<|> RuleM RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
f2 = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a) -> RuleM a
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a)
-> RuleM a)
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a)
-> RuleM a
forall a b. (a -> b) -> a -> b
$ \RuleOpts
env InScopeEnv
iu Id
fn [CoreExpr]
args ->
RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
f1 RuleOpts
env InScopeEnv
iu Id
fn [CoreExpr]
args Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe a
f2 RuleOpts
env InScopeEnv
iu Id
fn [CoreExpr]
args
instance MonadPlus RuleM
getPlatform :: RuleM Platform
getPlatform :: RuleM Platform
getPlatform = RuleOpts -> Platform
roPlatform (RuleOpts -> Platform) -> RuleM RuleOpts -> RuleM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuleM RuleOpts
getRuleOpts
getWordSize :: RuleM PlatformWordSize
getWordSize :: RuleM PlatformWordSize
getWordSize = Platform -> PlatformWordSize
platformWordSize (Platform -> PlatformWordSize)
-> RuleM Platform -> RuleM PlatformWordSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuleM Platform
getPlatform
getRuleOpts :: RuleM RuleOpts
getRuleOpts :: RuleM RuleOpts
getRuleOpts = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe RuleOpts)
-> RuleM RuleOpts
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe RuleOpts)
-> RuleM RuleOpts)
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe RuleOpts)
-> RuleM RuleOpts
forall a b. (a -> b) -> a -> b
$ \RuleOpts
rule_opts InScopeEnv
_ Id
_ [CoreExpr]
_ -> RuleOpts -> Maybe RuleOpts
forall a. a -> Maybe a
Just RuleOpts
rule_opts
liftMaybe :: Maybe a -> RuleM a
liftMaybe :: forall a. Maybe a -> RuleM a
liftMaybe Maybe a
Nothing = RuleM a
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
liftMaybe (Just a
x) = a -> RuleM a
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
liftLit :: (Literal -> Literal) -> RuleM CoreExpr
liftLit :: (Literal -> Literal) -> RuleM CoreExpr
liftLit Literal -> Literal
f = (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform ((Literal -> Literal) -> Platform -> Literal -> Literal
forall a b. a -> b -> a
const Literal -> Literal
f)
liftLitPlatform :: (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform :: (Platform -> Literal -> Literal) -> RuleM CoreExpr
liftLitPlatform Platform -> Literal -> Literal
f = do
Platform
platform <- RuleM Platform
getPlatform
[Lit Literal
lit] <- RuleM [CoreExpr]
getArgs
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (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 a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e
PlatformWordSize
PW8 ->
RuleM CoreExpr
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
getArgs :: RuleM [CoreExpr]
getArgs :: RuleM [CoreExpr]
getArgs = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe [CoreExpr])
-> RuleM [CoreExpr]
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe [CoreExpr])
-> RuleM [CoreExpr])
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe [CoreExpr])
-> RuleM [CoreExpr]
forall a b. (a -> b) -> a -> b
$ \RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
args -> [CoreExpr] -> Maybe [CoreExpr]
forall a. a -> Maybe a
Just [CoreExpr]
args
getInScopeEnv :: RuleM InScopeEnv
getInScopeEnv :: RuleM InScopeEnv
getInScopeEnv = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe InScopeEnv)
-> RuleM InScopeEnv
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe InScopeEnv)
-> RuleM InScopeEnv)
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe InScopeEnv)
-> RuleM InScopeEnv
forall a b. (a -> b) -> a -> b
$ \RuleOpts
_ InScopeEnv
iu Id
_ [CoreExpr]
_ -> InScopeEnv -> Maybe InScopeEnv
forall a. a -> Maybe a
Just InScopeEnv
iu
getFunction :: RuleM Id
getFunction :: RuleM Id
getFunction = (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe Id)
-> RuleM Id
forall r.
(RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r) -> RuleM r
RuleM ((RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe Id)
-> RuleM Id)
-> (RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe Id)
-> RuleM Id
forall a b. (a -> b) -> a -> b
$ \RuleOpts
_ InScopeEnv
_ Id
fn [CoreExpr]
_ -> Id -> Maybe Id
forall a. a -> Maybe a
Just Id
fn
isLiteral :: CoreExpr -> RuleM Literal
isLiteral :: CoreExpr -> RuleM Literal
isLiteral CoreExpr
e = do
InScopeEnv
env <- RuleM InScopeEnv
getInScopeEnv
case InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
e of
Maybe Literal
Nothing -> RuleM Literal
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Literal
l -> Literal -> RuleM Literal
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Literal
l
isBignumLiteral :: CoreExpr -> RuleM Integer
isBignumLiteral :: CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
e = CoreExpr -> RuleM Integer
isNumberLiteral CoreExpr
e RuleM Integer -> RuleM Integer -> RuleM Integer
forall a. RuleM a -> RuleM a -> RuleM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CoreExpr -> RuleM Integer
isIntegerLiteral CoreExpr
e RuleM Integer -> RuleM Integer -> RuleM Integer
forall a. RuleM a -> RuleM a -> RuleM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CoreExpr -> RuleM Integer
isNaturalLiteral CoreExpr
e
isNumberLiteral :: CoreExpr -> RuleM Integer
isNumberLiteral :: CoreExpr -> RuleM Integer
isNumberLiteral CoreExpr
e = CoreExpr -> RuleM Literal
isLiteral CoreExpr
e RuleM Literal -> (Literal -> RuleM Integer) -> RuleM Integer
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
LitNumber LitNumType
_ Integer
x -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
x
Literal
_ -> RuleM Integer
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
isLitNumConApp :: CoreExpr -> RuleM (DataCon,Integer)
isLitNumConApp :: CoreExpr -> RuleM (DataCon, Integer)
isLitNumConApp CoreExpr
e = do
InScopeEnv
env <- RuleM InScopeEnv
getInScopeEnv
case (() :: Constraint) =>
InScopeEnv
-> CoreExpr
-> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
InScopeEnv
-> CoreExpr
-> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
exprIsConApp_maybe InScopeEnv
env CoreExpr
e of
Just (InScopeSet
_env,[FloatBind]
_fb,DataCon
dc,[Type]
_tys,[CoreExpr
arg]) -> case InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
arg of
Just (LitNumber LitNumType
_ Integer
i) -> (DataCon, Integer) -> RuleM (DataCon, Integer)
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataCon
dc,Integer
i)
Maybe Literal
_ -> RuleM (DataCon, Integer)
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
_ -> RuleM (DataCon, Integer)
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
isIntegerLiteral :: CoreExpr -> RuleM Integer
isIntegerLiteral :: CoreExpr -> RuleM Integer
isIntegerLiteral CoreExpr
e = do
(DataCon
dc,Integer
i) <- CoreExpr -> RuleM (DataCon, Integer)
isLitNumConApp CoreExpr
e
if | DataCon
dc DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
integerISDataCon -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
| DataCon
dc DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
integerINDataCon -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i)
| DataCon
dc DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
integerIPDataCon -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
| Bool
otherwise -> RuleM Integer
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
isBigIntegerLiteral :: CoreExpr -> RuleM Integer
isBigIntegerLiteral :: CoreExpr -> RuleM Integer
isBigIntegerLiteral CoreExpr
e = do
(DataCon
dc,Integer
i) <- CoreExpr -> RuleM (DataCon, Integer)
isLitNumConApp CoreExpr
e
if | DataCon
dc DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
integerINDataCon -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i)
| DataCon
dc DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
integerIPDataCon -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
| Bool
otherwise -> RuleM Integer
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
isNaturalLiteral :: CoreExpr -> RuleM Integer
isNaturalLiteral :: CoreExpr -> RuleM Integer
isNaturalLiteral CoreExpr
e = do
(DataCon
dc,Integer
i) <- CoreExpr -> RuleM (DataCon, Integer)
isLitNumConApp CoreExpr
e
if | DataCon
dc DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
naturalNSDataCon -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
| DataCon
dc DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
naturalNBDataCon -> Integer -> RuleM Integer
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
| Bool
otherwise -> RuleM Integer
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
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
getRuleOpts
[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
getRuleOpts
[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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
op)
leftIdentity :: Literal -> RuleM CoreExpr
leftIdentity :: Literal -> RuleM CoreExpr
leftIdentity Literal
id_lit = (Platform -> Literal) -> RuleM CoreExpr
leftIdentityPlatform (Literal -> Platform -> Literal
forall a b. a -> b -> a
const Literal
id_lit)
rightIdentity :: Literal -> RuleM CoreExpr
rightIdentity :: Literal -> RuleM CoreExpr
rightIdentity Literal
id_lit = (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform (Literal -> Platform -> Literal
forall a b. a -> b -> a
const Literal
id_lit)
identity :: Literal -> RuleM CoreExpr
identity :: Literal -> RuleM CoreExpr
identity Literal
lit = Literal -> RuleM CoreExpr
leftIdentity Literal
lit RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
forall a. RuleM a -> RuleM a -> RuleM a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Literal -> RuleM CoreExpr
rightIdentity Literal
lit
leftIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
leftIdentityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
leftIdentityPlatform Platform -> Literal
id_lit = do
Platform
platform <- RuleM Platform
getPlatform
[Lit Literal
l1, CoreExpr
e2] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l1 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Literal
id_lit Platform
platform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e2
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 ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l1 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Literal
id_lit Platform
platform
let no_c :: CoreExpr
no_c = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [CoreExpr
e2, CoreExpr
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 ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l2 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Literal
id_lit Platform
platform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1
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 ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal
l2 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Literal
id_lit Platform
platform
let no_c :: CoreExpr
no_c = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Literal
zeroi Platform
platform)
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [CoreExpr
e1, CoreExpr
no_c])
identityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
identityPlatform :: (Platform -> Literal) -> RuleM CoreExpr
identityPlatform Platform -> Literal
lit =
(Platform -> Literal) -> RuleM CoreExpr
leftIdentityPlatform Platform -> Literal
lit RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
forall a. RuleM a -> RuleM a -> RuleM a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Platform -> Literal) -> RuleM CoreExpr
rightIdentityPlatform Platform -> Literal
lit
identityCPlatform :: (Platform -> Literal) -> RuleM CoreExpr
identityCPlatform :: (Platform -> Literal) -> RuleM CoreExpr
identityCPlatform Platform -> Literal
lit =
(Platform -> Literal) -> RuleM CoreExpr
leftIdentityCPlatform Platform -> Literal
lit RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
forall a. RuleM a -> RuleM a -> RuleM a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Platform -> Literal) -> RuleM CoreExpr
rightIdentityCPlatform Platform -> Literal
lit
leftZero :: RuleM CoreExpr
leftZero :: RuleM CoreExpr
leftZero = do
[Lit Literal
l1, CoreExpr
_] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal -> Bool
isZeroLit Literal
l1
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
l1
rightZero :: RuleM CoreExpr
rightZero :: RuleM CoreExpr
rightZero = do
[CoreExpr
_, Lit Literal
l2] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Literal -> Bool
isZeroLit Literal
l2
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
l2
zeroElem :: RuleM CoreExpr
zeroElem :: RuleM CoreExpr
zeroElem = RuleM CoreExpr
leftZero RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
forall a. RuleM a -> RuleM a -> RuleM a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RuleM CoreExpr
rightZero
equalArgs :: RuleM ()
equalArgs :: RuleM ()
equalArgs = do
[CoreExpr
e1, CoreExpr
e2] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ CoreExpr
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 a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> (Literal -> Bool) -> Literal -> RuleM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Literal -> Bool) -> Literal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Bool
isZeroLit
oneLit :: Int -> RuleM ()
oneLit :: ConTagZ -> RuleM ()
oneLit ConTagZ
n = ConTagZ -> RuleM Literal
getLiteral ConTagZ
n RuleM Literal -> (Literal -> RuleM ()) -> RuleM ()
forall a b. RuleM a -> (a -> RuleM b) -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> (Literal -> Bool) -> Literal -> RuleM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Bool
isOneLit
lift_bits_op :: forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
lift_bits_op :: forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
lift_bits_op a -> Integer
op = do
Platform
platform <- RuleM Platform
getPlatform
[Lit (LitNumber LitNumType
_ Integer
l)] <- RuleM [CoreExpr]
getArgs
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkWordLit Platform
platform (Integer -> CoreExpr) -> Integer -> CoreExpr
forall a b. (a -> b) -> a -> b
$ a -> Integer
op (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
l :: a)
pop_count :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
pop_count = forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
lift_bits_op @a (ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConTagZ -> Integer) -> (a -> ConTagZ) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ConTagZ
forall a. Bits a => a -> ConTagZ
popCount)
ctz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
ctz = forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
lift_bits_op @a (ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConTagZ -> Integer) -> (a -> ConTagZ) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ConTagZ
forall b. FiniteBits b => b -> ConTagZ
countTrailingZeros)
clz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr
clz = forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr
lift_bits_op @a (ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConTagZ -> Integer) -> (a -> ConTagZ) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ConTagZ
forall b. FiniteBits b => b -> ConTagZ
countLeadingZeros)
convFloating :: RuleOpts -> Literal -> Literal
convFloating :: RuleOpts -> Literal -> Literal
convFloating RuleOpts
env (LitFloat Rational
f) | Bool -> Bool
not (RuleOpts -> Bool
roExcessRationalPrecision RuleOpts
env) =
Rational -> Literal
LitFloat (Float -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
f :: Float ))
convFloating RuleOpts
env (LitDouble Rational
d) | Bool -> Bool
not (RuleOpts -> Bool
roExcessRationalPrecision RuleOpts
env) =
Rational -> Literal
LitDouble (Double -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
d :: Double))
convFloating RuleOpts
_ Literal
l = Literal
l
guardFloatDiv :: RuleM ()
guardFloatDiv :: RuleM ()
guardFloatDiv = do
[Lit (LitFloat Rational
f1), Lit (LitFloat Rational
f2)] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ (Rational
f1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/=Rational
0 Bool -> Bool -> Bool
|| Rational
f2 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0)
Bool -> Bool -> Bool
&& Rational
f2 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0
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 ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ (Rational
d1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/=Rational
0 Bool -> Bool -> Bool
|| Rational
d2 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0)
Bool -> Bool -> Bool
&& Rational
d2 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0
strengthReduction :: Literal -> PrimOp -> RuleM CoreExpr
strengthReduction :: Literal -> PrimOp -> RuleM CoreExpr
strengthReduction Literal
two_lit PrimOp
add_op = do
CoreExpr
arg <- [RuleM CoreExpr] -> RuleM CoreExpr
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ do [CoreExpr
arg, Lit Literal
mult_lit] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Literal
mult_lit Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
two_lit)
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
arg
, do [Lit Literal
mult_lit, CoreExpr
arg] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Literal
mult_lit Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
two_lit)
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
arg ]
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId 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
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
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
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 ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ PrimOp
op PrimOp -> PrimOp -> Bool
forall a. Eq a => a -> a -> Bool
== PrimOp
op'
tagToEnumRule :: RuleM CoreExpr
tagToEnumRule :: RuleM CoreExpr
tagToEnumRule = do
[Type Type
ty, Lit (LitNumber LitNumType
LitNumInt Integer
i)] <- RuleM [CoreExpr]
getArgs
case (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty of
Just (TyCon
tycon, [Type]
tc_args) | TyCon -> Bool
isEnumerationTyCon TyCon
tycon -> do
let tag :: ConTagZ
tag = Integer -> ConTagZ
forall a. Num a => Integer -> a
fromInteger Integer
i
correct_tag :: DataCon -> Bool
correct_tag DataCon
dc = (DataCon -> ConTagZ
dataConTagZ DataCon
dc) ConTagZ -> ConTagZ -> Bool
forall a. Eq a => a -> a -> Bool
== ConTagZ
tag
(DataCon
dc:[DataCon]
rest) <- [DataCon] -> RuleM [DataCon]
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([DataCon] -> RuleM [DataCon]) -> [DataCon] -> RuleM [DataCon]
forall a b. (a -> b) -> a -> b
$ (DataCon -> Bool) -> [DataCon] -> [DataCon]
forall a. (a -> Bool) -> [a] -> [a]
filter DataCon -> Bool
correct_tag (TyCon -> Maybe [DataCon]
tyConDataCons_maybe TyCon
tycon Maybe [DataCon] -> [DataCon] -> [DataCon]
forall a. Maybe a -> a -> a
`orElse` [])
Bool -> RuleM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert ([DataCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DataCon]
rest)
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ CoreExpr -> [Type] -> CoreExpr
forall b. Expr b -> [Type] -> Expr b
mkTyApps (Id -> CoreExpr
forall b. Id -> Expr b
Var (DataCon -> Id
dataConWorkId DataCon
dc)) [Type]
tc_args
Maybe (TyCon, [Type])
_ -> Bool -> String -> SDoc -> RuleM CoreExpr -> RuleM CoreExpr
forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace Bool
True String
"tagToEnum# on non-enumeration type" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) (RuleM CoreExpr -> RuleM CoreExpr)
-> RuleM CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Type -> String -> CoreExpr
mkImpossibleExpr Type
ty String
"tagToEnum# on non-enumeration type"
dataToTagRule :: RuleM CoreExpr
dataToTagRule :: RuleM CoreExpr
dataToTagRule = RuleM CoreExpr
a RuleM CoreExpr -> RuleM CoreExpr -> RuleM CoreExpr
forall a. RuleM a -> RuleM a -> RuleM a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RuleM CoreExpr
b
where
a :: RuleM CoreExpr
a = do
[Type Type
ty1, Var Id
tag_to_enum `App` Type Type
ty2 `App` CoreExpr
tag] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
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
`hasKey` Unique
tagToEnumKey
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ Type
ty1 Type -> Type -> Bool
`eqType` Type
ty2
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
tag
b :: RuleM CoreExpr
b = do
Platform
platform <- RuleM Platform
getPlatform
[CoreExpr
_, CoreExpr
val_arg] <- RuleM [CoreExpr]
getArgs
InScopeEnv
in_scope <- RuleM InScopeEnv
getInScopeEnv
(InScopeSet
_,[FloatBind]
floats, DataCon
dc,[Type]
_,[CoreExpr]
_) <- Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
-> RuleM (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
forall a. Maybe a -> RuleM a
liftMaybe (Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
-> RuleM (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr]))
-> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
-> RuleM (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) =>
InScopeEnv
-> CoreExpr
-> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
InScopeEnv
-> CoreExpr
-> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
exprIsConApp_maybe InScopeEnv
in_scope CoreExpr
val_arg
Bool -> RuleM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Bool -> Bool
not (TyCon -> Bool
isNewTyCon (DataCon -> TyCon
dataConTyCon DataCon
dc)))
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [FloatBind] -> CoreExpr -> CoreExpr
wrapFloats [FloatBind]
floats (Platform -> Integer -> CoreExpr
mkIntVal Platform
platform (ConTagZ -> Integer
forall a. Integral a => a -> Integer
toInteger (DataCon -> ConTagZ
dataConTagZ DataCon
dc)))
unsafeEqualityProofRule :: RuleM CoreExpr
unsafeEqualityProofRule :: RuleM CoreExpr
unsafeEqualityProofRule
= do { [Type Type
rep, Type Type
t1, Type Type
t2] <- RuleM [CoreExpr]
getArgs
; Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Type
t1 Type -> Type -> Bool
`eqType` Type
t2)
; Id
fn <- RuleM Id
getFunction
; let ([Id]
_, Type
ue) = Type -> ([Id], Type)
splitForAllTyCoVars (Id -> Type
idType Id
fn)
tc :: TyCon
tc = (() :: Constraint) => Type -> TyCon
Type -> TyCon
tyConAppTyCon Type
ue
(DataCon
dc:[DataCon]
_) = TyCon -> [DataCon]
tyConDataCons TyCon
tc
; CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> [Type] -> CoreExpr
forall b. Expr b -> [Type] -> Expr b
mkTyApps (Id -> CoreExpr
forall b. Id -> Expr b
Var (DataCon -> Id
dataConWrapId DataCon
dc)) [Type
rep, Type
t1]) }
seqRule :: RuleM CoreExpr
seqRule :: RuleM CoreExpr
seqRule = do
[Type Type
_ty_a, Type Type
_ty_s, CoreExpr
a, CoreExpr
s] <- RuleM [CoreExpr]
getArgs
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> RuleM ()) -> Bool -> RuleM ()
forall a b. (a -> b) -> a -> b
$ CoreExpr -> Bool
exprIsHNF CoreExpr
a
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [CoreExpr
s, CoreExpr
a]
sparkRule :: RuleM CoreExpr
sparkRule :: RuleM CoreExpr
sparkRule = RuleM CoreExpr
seqRule
builtinRules :: [CoreRule]
builtinRules :: [CoreRule]
builtinRules
= [BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
"CStringFoldrLit",
ru_fn :: Name
ru_fn = Name
unpackCStringFoldrName,
ru_nargs :: ConTagZ
ru_nargs = ConTagZ
4, ru_try :: RuleFun
ru_try = RuleFun
match_cstring_foldr_lit_C },
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
"CStringFoldrLitUtf8",
ru_fn :: Name
ru_fn = Name
unpackCStringFoldrUtf8Name,
ru_nargs :: ConTagZ
ru_nargs = ConTagZ
4, ru_try :: RuleFun
ru_try = RuleFun
match_cstring_foldr_lit_utf8 },
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
"CStringAppendLit",
ru_fn :: Name
ru_fn = Name
unpackCStringAppendName,
ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2, ru_try :: RuleFun
ru_try = RuleFun
match_cstring_append_lit_C },
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
"CStringAppendLitUtf8",
ru_fn :: Name
ru_fn = Name
unpackCStringAppendUtf8Name,
ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2, ru_try :: RuleFun
ru_try = RuleFun
match_cstring_append_lit_utf8 },
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
"EqString", ru_fn :: Name
ru_fn = Name
eqStringName,
ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2, ru_try :: RuleFun
ru_try = RuleFun
match_eq_string },
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
"CStringLength", ru_fn :: Name
ru_fn = Name
cstringLengthName,
ru_nargs :: ConTagZ
ru_nargs = ConTagZ
1, ru_try :: RuleFun
ru_try = RuleFun
match_cstring_length },
BuiltinRule { ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
"Inline", ru_fn :: Name
ru_fn = Name
inlineIdName,
ru_nargs :: ConTagZ
ru_nargs = ConTagZ
2, ru_try :: RuleFun
ru_try = \RuleOpts
_ InScopeEnv
_ Id
_ -> [CoreExpr] -> Maybe CoreExpr
match_inline },
Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkBasicRule Name
unsafeEqualityProofName ConTagZ
3 RuleM CoreExpr
unsafeEqualityProofRule,
Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkBasicRule Name
divIntName ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ [RuleM CoreExpr] -> RuleM CoreExpr
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
[ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div)
, RuleM CoreExpr
leftZero
, do
[CoreExpr
arg, Lit (LitNumber LitNumType
LitNumInt Integer
d)] <- RuleM [CoreExpr]
getArgs
Just Integer
n <- Maybe Integer -> RuleM (Maybe Integer)
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
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 a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
IntSraOp) 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
msum
[ ConTagZ -> RuleM ()
nonZeroLit ConTagZ
1 RuleM () -> RuleM CoreExpr -> RuleM CoreExpr
forall a b. RuleM a -> RuleM b -> RuleM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RuleOpts -> Literal -> Literal -> Maybe CoreExpr)
-> RuleM CoreExpr
binaryLit ((Integer -> Integer -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
forall a b.
(Integral a, Integral b) =>
(a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
intOp2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod)
, RuleM CoreExpr
leftZero
, do
[CoreExpr
arg, Lit (LitNumber LitNumType
LitNumInt Integer
d)] <- RuleM [CoreExpr]
getArgs
Just Integer
_ <- Maybe Integer -> RuleM (Maybe Integer)
forall a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
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 a. a -> RuleM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
IntAndOp)
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
- Integer
1)
]
]
[CoreRule] -> [CoreRule] -> [CoreRule]
forall a. [a] -> [a] -> [a]
++ [CoreRule]
builtinBignumRules
{-# NOINLINE builtinRules #-}
builtinBignumRules :: [CoreRule]
builtinBignumRules :: [CoreRule]
builtinBignumRules =
[
String -> Name -> CoreRule
lit_to_integer String
"Word# -> Integer" Name
integerFromWordName
, String -> Name -> CoreRule
lit_to_integer String
"Int64# -> Integer" Name
integerFromInt64Name
, String -> Name -> CoreRule
lit_to_integer String
"Word64# -> Integer" Name
integerFromWord64Name
, String -> Name -> CoreRule
lit_to_integer String
"Natural -> Integer" Name
integerFromNaturalName
, String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
integer_to_lit String
"Integer -> Word# (wrap)" Name
integerToWordName Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkWordLitWrap
, String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
integer_to_lit String
"Integer -> Int# (wrap)" Name
integerToIntName Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkIntLitWrap
, String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
integer_to_lit String
"Integer -> Word64# (wrap)" Name
integerToWord64Name (\Platform
_ -> Word64 -> CoreExpr
forall b. Word64 -> Expr b
mkWord64LitWord64 (Word64 -> CoreExpr) -> (Integer -> Word64) -> Integer -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger)
, String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
integer_to_lit String
"Integer -> Int64# (wrap)" Name
integerToInt64Name (\Platform
_ -> Int64 -> CoreExpr
forall b. Int64 -> Expr b
mkInt64LitInt64 (Int64 -> CoreExpr) -> (Integer -> Int64) -> Integer -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a. Num a => Integer -> a
fromInteger)
, String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
integer_to_lit String
"Integer -> Float#" Name
integerToFloatName (\Platform
_ -> Float -> CoreExpr
forall b. Float -> Expr b
mkFloatLitFloat (Float -> CoreExpr) -> (Integer -> Float) -> Integer -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Float
forall a. Num a => Integer -> a
fromInteger)
, String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
integer_to_lit String
"Integer -> Double#" Name
integerToDoubleName (\Platform
_ -> Double -> CoreExpr
forall b. Double -> Expr b
mkDoubleLitDouble (Double -> CoreExpr) -> (Integer -> Double) -> Integer -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger)
, String -> Name -> Bool -> Bool -> CoreRule
integer_to_natural String
"Integer -> Natural (clamp)" Name
integerToNaturalClampName Bool
False Bool
True
, String -> Name -> Bool -> Bool -> CoreRule
integer_to_natural String
"Integer -> Natural (wrap)" Name
integerToNaturalName Bool
False Bool
False
, String -> Name -> Bool -> Bool -> CoreRule
integer_to_natural String
"Integer -> Natural (throw)" Name
integerToNaturalThrowName Bool
True Bool
False
, String -> Name -> CoreRule
natural_to_word String
"Natural -> Word# (wrap)" Name
naturalToWordName
, String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
bignum_bin_pred String
"bigNatEq#" Name
bignatEqName Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==)
, String -> Name -> CoreRule
bignum_compare String
"bignatCompare" Name
bignatCompareName
, String -> Name -> CoreRule
bignum_compare String
"bignatCompareWord#" Name
bignatCompareWordName
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
integer_binop String
"integerAdd" Name
integerAddName Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
integer_binop String
"integerSub" Name
integerSubName (-)
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
integer_binop String
"integerMul" Name
integerMulName Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*)
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
integer_binop String
"integerGcd" Name
integerGcdName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
integer_binop String
"integerLcm" Name
integerLcmName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
integer_binop String
"integerAnd" Name
integerAndName Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.)
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
integer_binop String
"integerOr" Name
integerOrName Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.)
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
integer_binop String
"integerXor" Name
integerXorName Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
natural_binop String
"naturalAdd" Name
naturalAddName Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
natural_binop String
"naturalMul" Name
naturalMulName Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*)
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
natural_binop String
"naturalGcd" Name
naturalGcdName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
natural_binop String
"naturalLcm" Name
naturalLcmName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
natural_binop String
"naturalAnd" Name
naturalAndName Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.)
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
natural_binop String
"naturalOr" Name
naturalOrName Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.)
, String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
natural_binop String
"naturalXor" Name
naturalXorName Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor
, String -> Name -> CoreRule
natural_sub String
"naturalSubUnsafe" Name
naturalSubUnsafeName
, String -> Name -> CoreRule
natural_sub String
"naturalSubThrow" Name
naturalSubThrowName
, String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
"naturalSub" Name
naturalSubName ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isNaturalLiteral CoreExpr
a0
Integer
y <- CoreExpr -> RuleM Integer
isNaturalLiteral CoreExpr
a1
let ret :: ConTagZ -> CoreExpr -> f CoreExpr
ret ConTagZ
n CoreExpr
v = CoreExpr -> f CoreExpr
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> f CoreExpr) -> CoreExpr -> f CoreExpr
forall a b. (a -> b) -> a -> b
$ ConTagZ -> ConTagZ -> [Type] -> CoreExpr -> CoreExpr
mkCoreUnboxedSum ConTagZ
2 ConTagZ
n [Type
unboxedUnitTy,Type
naturalTy] CoreExpr
v
Platform
platform <- RuleM Platform
getPlatform
if Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
y
then ConTagZ -> CoreExpr -> RuleM CoreExpr
forall {f :: * -> *}.
Applicative f =>
ConTagZ -> CoreExpr -> f CoreExpr
ret ConTagZ
1 CoreExpr
unboxedUnitExpr
else ConTagZ -> CoreExpr -> RuleM CoreExpr
forall {f :: * -> *}.
Applicative f =>
ConTagZ -> CoreExpr -> f CoreExpr
ret ConTagZ
2 (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> Integer -> CoreExpr
mkNaturalExpr Platform
platform (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y)
, String
-> Name
-> (Platform -> Integer -> CoreExpr)
-> (Integer -> Integer)
-> CoreRule
forall {t}.
String
-> Name
-> (Platform -> t -> CoreExpr)
-> (Integer -> t)
-> CoreRule
bignum_unop String
"integerNegate" Name
integerNegateName Platform -> Integer -> CoreExpr
mkIntegerExpr Integer -> Integer
forall a. Num a => a -> a
negate
, String
-> Name
-> (Platform -> Integer -> CoreExpr)
-> (Integer -> Integer)
-> CoreRule
forall {t}.
String
-> Name
-> (Platform -> t -> CoreExpr)
-> (Integer -> t)
-> CoreRule
bignum_unop String
"integerAbs" Name
integerAbsName Platform -> Integer -> CoreExpr
mkIntegerExpr Integer -> Integer
forall a. Num a => a -> a
abs
, String
-> Name
-> (Platform -> Integer -> CoreExpr)
-> (Integer -> Integer)
-> CoreRule
forall {t}.
String
-> Name
-> (Platform -> t -> CoreExpr)
-> (Integer -> t)
-> CoreRule
bignum_unop String
"integerComplement" Name
integerComplementName Platform -> Integer -> CoreExpr
mkIntegerExpr Integer -> Integer
forall a. Bits a => a -> a
complement
, String -> Name -> (Platform -> Integer -> Literal) -> CoreRule
forall {t}.
Num t =>
String -> Name -> (Platform -> t -> Literal) -> CoreRule
bignum_popcount String
"integerPopCount" Name
integerPopCountName Platform -> Integer -> Literal
mkLitIntWrap
, String -> Name -> (Platform -> Integer -> Literal) -> CoreRule
forall {t}.
Num t =>
String -> Name -> (Platform -> t -> Literal) -> CoreRule
bignum_popcount String
"naturalPopCount" Name
naturalPopCountName Platform -> Integer -> Literal
mkLitWordWrap
, String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
forall {t}.
Bits t =>
String -> Name -> (Platform -> t -> CoreExpr) -> CoreRule
bignum_bit String
"integerBit" Name
integerBitName Platform -> Integer -> CoreExpr
mkIntegerExpr
, String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
forall {t}.
Bits t =>
String -> Name -> (Platform -> t -> CoreExpr) -> CoreRule
bignum_bit String
"naturalBit" Name
naturalBitName Platform -> Integer -> CoreExpr
mkNaturalExpr
, String -> Name -> CoreRule
bignum_testbit String
"integerTestBit" Name
integerTestBitName
, String -> Name -> CoreRule
bignum_testbit String
"naturalTestBit" Name
naturalTestBitName
, String
-> Name
-> (Integer -> ConTagZ -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t} {t}.
Num t =>
String
-> Name
-> (Integer -> t -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
bignum_shift String
"integerShiftL" Name
integerShiftLName Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL Platform -> Integer -> CoreExpr
mkIntegerExpr
, String
-> Name
-> (Integer -> ConTagZ -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t} {t}.
Num t =>
String
-> Name
-> (Integer -> t -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
bignum_shift String
"integerShiftR" Name
integerShiftRName Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR Platform -> Integer -> CoreExpr
mkIntegerExpr
, String
-> Name
-> (Integer -> ConTagZ -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t} {t}.
Num t =>
String
-> Name
-> (Integer -> t -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
bignum_shift String
"naturalShiftL" Name
naturalShiftLName Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftL Platform -> Integer -> CoreExpr
mkNaturalExpr
, String
-> Name
-> (Integer -> ConTagZ -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t} {t}.
Num t =>
String
-> Name
-> (Integer -> t -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
bignum_shift String
"naturalShiftR" Name
naturalShiftRName Integer -> ConTagZ -> Integer
forall a. Bits a => a -> ConTagZ -> a
shiftR Platform -> Integer -> CoreExpr
mkNaturalExpr
, String
-> Name
-> (Integer -> Integer -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t}.
String
-> Name
-> (Integer -> Integer -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_one String
"integerQuot" Name
integerQuotName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Platform -> Integer -> CoreExpr
mkIntegerExpr
, String
-> Name
-> (Integer -> Integer -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t}.
String
-> Name
-> (Integer -> Integer -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_one String
"integerRem" Name
integerRemName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem Platform -> Integer -> CoreExpr
mkIntegerExpr
, String
-> Name
-> (Integer -> Integer -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t}.
String
-> Name
-> (Integer -> Integer -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_one String
"integerDiv" Name
integerDivName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Platform -> Integer -> CoreExpr
mkIntegerExpr
, String
-> Name
-> (Integer -> Integer -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t}.
String
-> Name
-> (Integer -> Integer -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_one String
"integerMod" Name
integerModName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Platform -> Integer -> CoreExpr
mkIntegerExpr
, String
-> Name
-> (Integer -> Integer -> (Integer, Integer))
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t}.
String
-> Name
-> (Integer -> Integer -> (t, t))
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_both String
"integerDivMod" Name
integerDivModName Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Platform -> Integer -> CoreExpr
mkIntegerExpr
, String
-> Name
-> (Integer -> Integer -> (Integer, Integer))
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t}.
String
-> Name
-> (Integer -> Integer -> (t, t))
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_both String
"integerQuotRem" Name
integerQuotRemName Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Platform -> Integer -> CoreExpr
mkIntegerExpr
, String
-> Name
-> (Integer -> Integer -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t}.
String
-> Name
-> (Integer -> Integer -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_one String
"naturalQuot" Name
naturalQuotName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Platform -> Integer -> CoreExpr
mkNaturalExpr
, String
-> Name
-> (Integer -> Integer -> Integer)
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t}.
String
-> Name
-> (Integer -> Integer -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_one String
"naturalRem" Name
naturalRemName Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem Platform -> Integer -> CoreExpr
mkNaturalExpr
, String
-> Name
-> (Integer -> Integer -> (Integer, Integer))
-> (Platform -> Integer -> CoreExpr)
-> CoreRule
forall {t}.
String
-> Name
-> (Integer -> Integer -> (t, t))
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_both String
"naturalQuotRem" Name
naturalQuotRemName Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Platform -> Integer -> CoreExpr
mkNaturalExpr
, String -> Name -> (Float -> CoreExpr) -> CoreRule
forall a.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
rational_to String
"rationalToFloat" Name
rationalToFloatName Float -> CoreExpr
mkFloatExpr
, String -> Name -> (Double -> CoreExpr) -> CoreRule
forall a.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
rational_to String
"rationalToDouble" Name
rationalToDoubleName Double -> CoreExpr
mkDoubleExpr
, String -> Name -> (Float -> CoreExpr) -> CoreRule
forall a.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
integer_encode_float String
"integerEncodeFloat" Name
integerEncodeFloatName Float -> CoreExpr
forall b. Float -> Expr b
mkFloatLitFloat
, String -> Name -> (Double -> CoreExpr) -> CoreRule
forall a.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
integer_encode_float String
"integerEncodeDouble" Name
integerEncodeDoubleName Double -> CoreExpr
forall b. Double -> Expr b
mkDoubleLitDouble
]
where
mkRule :: String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
nargs RuleM CoreExpr
f = BuiltinRule
{ ru_name :: RuleName
ru_name = String -> RuleName
fsLit String
str
, ru_fn :: Name
ru_fn = Name
name
, ru_nargs :: ConTagZ
ru_nargs = ConTagZ
nargs
, ru_try :: RuleFun
ru_try = RuleM CoreExpr -> RuleFun
forall r.
RuleM r -> RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r
runRuleM (RuleM CoreExpr -> RuleFun) -> RuleM CoreExpr -> RuleFun
forall a b. (a -> b) -> a -> b
$ do
RuleOpts
env <- RuleM RuleOpts
getRuleOpts
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RuleOpts -> Bool
roBignumRules RuleOpts
env)
RuleM CoreExpr
f
}
integer_to_lit :: String -> Name -> (Platform -> Integer -> CoreExpr) -> CoreRule
integer_to_lit String
str Name
name Platform -> Integer -> CoreExpr
convert = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Integer
x <- CoreExpr -> RuleM Integer
isBigIntegerLiteral CoreExpr
a0
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Platform -> Integer -> CoreExpr
convert Platform
platform Integer
x)
natural_to_word :: String -> Name -> CoreRule
natural_to_word String
str Name
name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0] <- RuleM [CoreExpr]
getArgs
Integer
n <- CoreExpr -> RuleM Integer
isNaturalLiteral CoreExpr
a0
Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitWordWrap Platform
platform Integer
n))
integer_to_natural :: String -> Name -> Bool -> Bool -> CoreRule
integer_to_natural String
str Name
name Bool
thrw Bool
clamp = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isIntegerLiteral CoreExpr
a0
Platform
platform <- RuleM Platform
getPlatform
if | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> Integer -> CoreExpr
mkNaturalExpr Platform
platform Integer
x
| Bool
thrw -> RuleM CoreExpr
forall a. RuleM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
| Bool
clamp -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> Integer -> CoreExpr
mkNaturalExpr Platform
platform Integer
0
| Bool
otherwise -> CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> Integer -> CoreExpr
mkNaturalExpr Platform
platform (Integer -> Integer
forall a. Num a => a -> a
abs Integer
x)
lit_to_integer :: String -> Name -> CoreRule
lit_to_integer String
str Name
name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Integer
i <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a0
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Platform -> Integer -> CoreExpr
mkIntegerExpr Platform
platform Integer
i)
integer_binop :: String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
integer_binop String
str Name
name Integer -> Integer -> Integer
op = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isIntegerLiteral CoreExpr
a0
Integer
y <- CoreExpr -> RuleM Integer
isIntegerLiteral CoreExpr
a1
Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Platform -> Integer -> CoreExpr
mkIntegerExpr Platform
platform (Integer
x Integer -> Integer -> Integer
`op` Integer
y))
natural_binop :: String -> Name -> (Integer -> Integer -> Integer) -> CoreRule
natural_binop String
str Name
name Integer -> Integer -> Integer
op = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isNaturalLiteral CoreExpr
a0
Integer
y <- CoreExpr -> RuleM Integer
isNaturalLiteral CoreExpr
a1
Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Platform -> Integer -> CoreExpr
mkNaturalExpr Platform
platform (Integer
x Integer -> Integer -> Integer
`op` Integer
y))
natural_sub :: String -> Name -> CoreRule
natural_sub String
str Name
name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isNaturalLiteral CoreExpr
a0
Integer
y <- CoreExpr -> RuleM Integer
isNaturalLiteral CoreExpr
a1
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
y)
Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Platform -> Integer -> CoreExpr
mkNaturalExpr Platform
platform (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y))
bignum_bin_pred :: String -> Name -> (Integer -> Integer -> Bool) -> CoreRule
bignum_bin_pred String
str Name
name Integer -> Integer -> Bool
op = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
Platform
platform <- RuleM Platform
getPlatform
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a0
Integer
y <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a1
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ if Integer
x Integer -> Integer -> Bool
`op` Integer
y
then Platform -> CoreExpr
trueValInt Platform
platform
else Platform -> CoreExpr
falseValInt Platform
platform
bignum_compare :: String -> Name -> CoreRule
bignum_compare String
str Name
name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a0
Integer
y <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a1
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ case Integer
x Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
y of
Ordering
LT -> CoreExpr
ltVal
Ordering
EQ -> CoreExpr
eqVal
Ordering
GT -> CoreExpr
gtVal
bignum_unop :: String
-> Name
-> (Platform -> t -> CoreExpr)
-> (Integer -> t)
-> CoreRule
bignum_unop String
str Name
name Platform -> t -> CoreExpr
mk_lit Integer -> t
op = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a0
Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> t -> CoreExpr
mk_lit Platform
platform (Integer -> t
op Integer
x)
bignum_popcount :: String -> Name -> (Platform -> t -> Literal) -> CoreRule
bignum_popcount String
str Name
name Platform -> t -> Literal
mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
Platform
platform <- RuleM Platform
getPlatform
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Platform -> ConTagZ
platformWordSizeInBits Platform
platform ConTagZ -> ConTagZ -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> ConTagZ
forall b. FiniteBits b => b -> ConTagZ
finiteBitSize (Word
0 :: Word))
[CoreExpr
a0] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a0
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> t -> Literal
mk_lit Platform
platform (ConTagZ -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ConTagZ
forall a. Bits a => a -> ConTagZ
popCount Integer
x)))
bignum_bit :: String -> Name -> (Platform -> t -> CoreExpr) -> CoreRule
bignum_bit String
str Name
name Platform -> t -> CoreExpr
mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
1 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Integer
n <- CoreExpr -> RuleM Integer
isNumberLiteral CoreExpr
a0
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Platform -> ConTagZ
platformWordSizeInBits Platform
platform))
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> t -> CoreExpr
mk_lit Platform
platform (ConTagZ -> t
forall a. Bits a => ConTagZ -> a
bit (Integer -> ConTagZ
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n))
bignum_testbit :: String -> Name -> CoreRule
bignum_testbit String
str Name
name = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Integer
x <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a0
Integer
n <- CoreExpr -> RuleM Integer
isNumberLiteral CoreExpr
a1
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConTagZ
forall a. Bounded a => a
maxBound :: Int))
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ if Integer -> ConTagZ -> Bool
forall a. Bits a => a -> ConTagZ -> Bool
testBit Integer
x (Integer -> ConTagZ
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
then Platform -> CoreExpr
trueValInt Platform
platform
else Platform -> CoreExpr
falseValInt Platform
platform
bignum_shift :: String
-> Name
-> (Integer -> t -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
bignum_shift String
str Name
name Integer -> t -> t
shift_op Platform -> t -> CoreExpr
mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a0
Integer
n <- CoreExpr -> RuleM Integer
isNumberLiteral CoreExpr
a1
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
4)
Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> t -> CoreExpr
mk_lit Platform
platform (Integer
x Integer -> t -> t
`shift_op` Integer -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
divop_one :: String
-> Name
-> (Integer -> Integer -> t)
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_one String
str Name
name Integer -> Integer -> t
divop Platform -> t -> CoreExpr
mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
n <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a0
Integer
d <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a1
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)
Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ Platform -> t -> CoreExpr
mk_lit Platform
platform (Integer
n Integer -> Integer -> t
`divop` Integer
d)
divop_both :: String
-> Name
-> (Integer -> Integer -> (t, t))
-> (Platform -> t -> CoreExpr)
-> CoreRule
divop_both String
str Name
name Integer -> Integer -> (t, t)
divop Platform -> t -> CoreExpr
mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
n <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a0
Integer
d <- CoreExpr -> RuleM Integer
isBignumLiteral CoreExpr
a1
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)
let (t
r,t
s) = Integer
n Integer -> Integer -> (t, t)
`divop` Integer
d
Platform
platform <- RuleM Platform
getPlatform
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [Platform -> t -> CoreExpr
mk_lit Platform
platform t
r, Platform -> t -> CoreExpr
mk_lit Platform
platform t
s]
integer_encode_float :: RealFloat a => String -> Name -> (a -> CoreExpr) -> CoreRule
integer_encode_float :: forall a.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
integer_encode_float String
str Name
name a -> CoreExpr
mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
x <- CoreExpr -> RuleM Integer
isIntegerLiteral CoreExpr
a0
Integer
y <- CoreExpr -> RuleM Integer
isNumberLiteral CoreExpr
a1
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConTagZ
forall a. Bounded a => a
maxBound :: Int))
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> CoreExpr
mk_lit (a -> CoreExpr) -> a -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Integer -> ConTagZ -> a
forall a. RealFloat a => Integer -> ConTagZ -> a
encodeFloat Integer
x (Integer -> ConTagZ
forall a. Num a => Integer -> a
fromInteger Integer
y))
rational_to :: RealFloat a => String -> Name -> (a -> CoreExpr) -> CoreRule
rational_to :: forall a.
RealFloat a =>
String -> Name -> (a -> CoreExpr) -> CoreRule
rational_to String
str Name
name a -> CoreExpr
mk_lit = String -> Name -> ConTagZ -> RuleM CoreExpr -> CoreRule
mkRule String
str Name
name ConTagZ
2 (RuleM CoreExpr -> CoreRule) -> RuleM CoreExpr -> CoreRule
forall a b. (a -> b) -> a -> b
$ do
[CoreExpr
a0,CoreExpr
a1] <- RuleM [CoreExpr]
getArgs
Integer
n <- CoreExpr -> RuleM Integer
isIntegerLiteral CoreExpr
a0
Integer
d <- CoreExpr -> RuleM Integer
isIntegerLiteral CoreExpr
a1
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)
CoreExpr -> RuleM CoreExpr
forall a. a -> RuleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> RuleM CoreExpr) -> CoreExpr -> RuleM CoreExpr
forall a b. (a -> b) -> a -> b
$ a -> CoreExpr
mk_lit (Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
d))
match_cstring_append_lit_C :: RuleFun
match_cstring_append_lit_C :: RuleFun
match_cstring_append_lit_C = Unique -> Unique -> RuleFun
match_cstring_append_lit Unique
unpackCStringAppendIdKey Unique
unpackCStringIdKey
match_cstring_append_lit_utf8 :: RuleFun
match_cstring_append_lit_utf8 :: RuleFun
match_cstring_append_lit_utf8 = Unique -> Unique -> RuleFun
match_cstring_append_lit Unique
unpackCStringAppendUtf8IdKey Unique
unpackCStringUtf8IdKey
{-# INLINE match_cstring_append_lit #-}
match_cstring_append_lit :: Unique -> Unique -> RuleFun
match_cstring_append_lit :: Unique -> Unique -> RuleFun
match_cstring_append_lit Unique
append_key Unique
unpack_key RuleOpts
_ InScopeEnv
env Id
_ [CoreExpr
lit1, CoreExpr
e2]
| Just (LitString ByteString
s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
lit1
, ([CoreTickish]
strTicks, Var Id
unpk `App` CoreExpr
lit2) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
stripStrTopTicks InScopeEnv
env CoreExpr
e2
, Id
unpk Id -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
unpack_key
, Just (LitString ByteString
s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
lit2
= CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreTickish] -> CoreExpr -> CoreExpr
mkTicks [CoreTickish]
strTicks
(CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> CoreExpr
forall b. Id -> Expr b
Var Id
unpk CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (ByteString -> Literal
LitString (ByteString
s1 ByteString -> ByteString -> ByteString
`BS.append` ByteString
s2))
| Just (LitString ByteString
s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
lit1
, ([CoreTickish]
strTicks, Var Id
appnd `App` CoreExpr
lit2 `App` CoreExpr
e) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
stripStrTopTicks InScopeEnv
env CoreExpr
e2
, Id
appnd Id -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
append_key
, Just (LitString ByteString
s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
lit2
= CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreTickish] -> CoreExpr -> CoreExpr
mkTicks [CoreTickish]
strTicks
(CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> CoreExpr
forall b. Id -> Expr b
Var Id
appnd CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (ByteString -> Literal
LitString (ByteString
s1 ByteString -> ByteString -> ByteString
`BS.append` ByteString
s2)) CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
e
match_cstring_append_lit Unique
_ Unique
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
match_cstring_foldr_lit_C :: RuleFun
match_cstring_foldr_lit_C :: RuleFun
match_cstring_foldr_lit_C = Unique -> RuleFun
match_cstring_foldr_lit Unique
unpackCStringFoldrIdKey
match_cstring_foldr_lit_utf8 :: RuleFun
match_cstring_foldr_lit_utf8 :: RuleFun
match_cstring_foldr_lit_utf8 = Unique -> RuleFun
match_cstring_foldr_lit Unique
unpackCStringFoldrUtf8IdKey
{-# INLINE match_cstring_foldr_lit #-}
match_cstring_foldr_lit :: Unique -> RuleFun
match_cstring_foldr_lit :: Unique -> RuleFun
match_cstring_foldr_lit Unique
foldVariant RuleOpts
_ InScopeEnv
env Id
_
[ Type Type
ty1
, CoreExpr
lit1
, CoreExpr
c1
, CoreExpr
e2
]
| ([CoreTickish]
strTicks, Var Id
unpk `App` Type Type
ty2
`App` CoreExpr
lit2
`App` CoreExpr
c2
`App` CoreExpr
n) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
stripStrTopTicks InScopeEnv
env CoreExpr
e2
, Id
unpk Id -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
foldVariant
, Just (LitString ByteString
s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
lit1
, Just (LitString ByteString
s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
lit2
, CoreExpr -> CoreExpr -> Bool
eqCoreExpr CoreExpr
c1 CoreExpr
c2
, ([CoreTickish]
c1Ticks, CoreExpr
c1') <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
stripStrTopTicks InScopeEnv
env CoreExpr
c1
, [CoreTickish]
c2Ticks <- CoreExpr -> [CoreTickish]
stripStrTopTicksT CoreExpr
c2
= Bool -> Maybe CoreExpr -> Maybe CoreExpr
forall a. HasCallStack => Bool -> a -> a
assert (Type
ty1 Type -> Type -> Bool
`eqType` Type
ty2) (Maybe CoreExpr -> Maybe CoreExpr)
-> Maybe CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$
CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreTickish] -> CoreExpr -> CoreExpr
mkTicks [CoreTickish]
strTicks
(CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Id -> CoreExpr
forall b. Id -> Expr b
Var Id
unpk CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` Type -> CoreExpr
forall b. Type -> Expr b
Type Type
ty1
CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (ByteString -> Literal
LitString (ByteString
s1 ByteString -> ByteString -> ByteString
`BS.append` ByteString
s2))
CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` [CoreTickish] -> CoreExpr -> CoreExpr
mkTicks ([CoreTickish]
c1Ticks [CoreTickish] -> [CoreTickish] -> [CoreTickish]
forall a. [a] -> [a] -> [a]
++ [CoreTickish]
c2Ticks) CoreExpr
c1'
CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr
n
match_cstring_foldr_lit Unique
_ RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
stripStrTopTicks :: InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
stripStrTopTicks :: InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
stripStrTopTicks (ISE InScopeSet
_ IdUnfoldingFun
id_unf) CoreExpr
e = case CoreExpr
e of
Var Id
v
| Just CoreExpr
rhs <- Unfolding -> Maybe CoreExpr
expandUnfolding_maybe (IdUnfoldingFun
id_unf Id
v)
-> (CoreTickish -> Bool) -> CoreExpr -> ([CoreTickish], CoreExpr)
forall b.
(CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b)
stripTicksTop CoreTickish -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
tickishFloatable CoreExpr
rhs
CoreExpr
_ -> (CoreTickish -> Bool) -> CoreExpr -> ([CoreTickish], CoreExpr)
forall b.
(CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b)
stripTicksTop CoreTickish -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
tickishFloatable CoreExpr
e
stripStrTopTicksT :: CoreExpr -> [CoreTickish]
stripStrTopTicksT :: CoreExpr -> [CoreTickish]
stripStrTopTicksT CoreExpr
e = (CoreTickish -> Bool) -> CoreExpr -> [CoreTickish]
forall b. (CoreTickish -> Bool) -> Expr b -> [CoreTickish]
stripTicksTopT CoreTickish -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
tickishFloatable CoreExpr
e
match_eq_string :: RuleFun
match_eq_string :: RuleFun
match_eq_string RuleOpts
_ InScopeEnv
env Id
_ [CoreExpr
e1, CoreExpr
e2]
| ([CoreTickish]
ticks1, Var Id
unpk1 `App` CoreExpr
lit1) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
stripStrTopTicks InScopeEnv
env CoreExpr
e1
, ([CoreTickish]
ticks2, Var Id
unpk2 `App` CoreExpr
lit2) <- InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)
stripStrTopTicks InScopeEnv
env CoreExpr
e2
, Unique
unpk_key1 <- Id -> Unique
forall a. Uniquable a => a -> Unique
getUnique Id
unpk1
, Unique
unpk_key2 <- Id -> Unique
forall a. Uniquable a => a -> Unique
getUnique Id
unpk2
, Unique
unpk_key1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
unpk_key2
, Unique
unpk_key1 Unique -> [Unique] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Unique
unpackCStringUtf8IdKey, Unique
unpackCStringIdKey]
, Just (LitString ByteString
s1) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
lit1
, Just (LitString ByteString
s2) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
lit2
= CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$ [CoreTickish] -> CoreExpr -> CoreExpr
mkTicks ([CoreTickish]
ticks1 [CoreTickish] -> [CoreTickish] -> [CoreTickish]
forall a. [a] -> [a] -> [a]
++ [CoreTickish]
ticks2)
(CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
forall a b. (a -> b) -> a -> b
$ (if ByteString
s1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
s2 then CoreExpr
trueValBool else CoreExpr
falseValBool)
match_eq_string RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
match_cstring_length :: RuleFun
match_cstring_length :: RuleFun
match_cstring_length RuleOpts
rule_env InScopeEnv
env Id
_ [CoreExpr
lit1]
| Just (LitString ByteString
str) <- InScopeEnv -> CoreExpr -> Maybe Literal
exprIsLiteral_maybe InScopeEnv
env CoreExpr
lit1
= let len :: ConTagZ
len = ConTagZ -> Maybe ConTagZ -> ConTagZ
forall a. a -> Maybe a -> a
fromMaybe (ByteString -> ConTagZ
BS.length ByteString
str) (Word8 -> ByteString -> Maybe ConTagZ
BS.elemIndex Word8
0 ByteString
str)
in CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitInt (RuleOpts -> Platform
roPlatform RuleOpts
rule_env) (ConTagZ -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConTagZ
len)))
match_cstring_length RuleOpts
_ InScopeEnv
_ Id
_ [CoreExpr]
_ = Maybe CoreExpr
forall a. Maybe a
Nothing
match_inline :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)
match_inline :: [CoreExpr] -> Maybe CoreExpr
match_inline (Type Type
_ : CoreExpr
e : [CoreExpr]
_)
| (Var Id
f, [CoreExpr]
args1) <- CoreExpr -> (CoreExpr, [CoreExpr])
forall b. Expr b -> (Expr b, [Expr b])
collectArgs CoreExpr
e,
Just CoreExpr
unf <- Unfolding -> Maybe CoreExpr
maybeUnfoldingTemplate (IdUnfoldingFun
realIdUnfolding Id
f)
= 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
addFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
addFoldingRules PrimOp
op NumOps
num_ops = do
Bool -> RuleM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (PrimOp
op PrimOp -> PrimOp -> Bool
forall a. Eq a => a -> a -> Bool
== NumOps -> PrimOp
numAdd NumOps
num_ops)
RuleOpts
env <- RuleM RuleOpts
getRuleOpts
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RuleOpts -> Bool
roNumConstantFolding RuleOpts
env)
[CoreExpr
arg1,CoreExpr
arg2] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Maybe CoreExpr -> RuleM CoreExpr
forall a. Maybe a -> RuleM a
liftMaybe
(Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
addFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops
Maybe CoreExpr -> Maybe CoreExpr -> Maybe CoreExpr
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
addFoldingRules' Platform
platform CoreExpr
arg2 CoreExpr
arg1 NumOps
num_ops)
subFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
subFoldingRules PrimOp
op NumOps
num_ops = do
Bool -> RuleM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (PrimOp
op PrimOp -> PrimOp -> Bool
forall a. Eq a => a -> a -> Bool
== NumOps -> PrimOp
numSub NumOps
num_ops)
RuleOpts
env <- RuleM RuleOpts
getRuleOpts
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RuleOpts -> Bool
roNumConstantFolding RuleOpts
env)
[CoreExpr
arg1,CoreExpr
arg2] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Maybe CoreExpr -> RuleM CoreExpr
forall a. Maybe a -> RuleM a
liftMaybe (Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
subFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops)
mulFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr
mulFoldingRules PrimOp
op NumOps
num_ops = do
Bool -> RuleM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (PrimOp
op PrimOp -> PrimOp -> Bool
forall a. Eq a => a -> a -> Bool
== NumOps -> PrimOp
numMul NumOps
num_ops)
RuleOpts
env <- RuleM RuleOpts
getRuleOpts
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RuleOpts -> Bool
roNumConstantFolding RuleOpts
env)
[CoreExpr
arg1,CoreExpr
arg2] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Maybe CoreExpr -> RuleM CoreExpr
forall a. Maybe a -> RuleM a
liftMaybe
(Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
mulFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops
Maybe CoreExpr -> Maybe CoreExpr -> Maybe CoreExpr
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
mulFoldingRules' Platform
platform CoreExpr
arg2 CoreExpr
arg1 NumOps
num_ops)
andFoldingRules :: NumOps -> RuleM CoreExpr
andFoldingRules :: NumOps -> RuleM CoreExpr
andFoldingRules NumOps
num_ops = do
RuleOpts
env <- RuleM RuleOpts
getRuleOpts
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RuleOpts -> Bool
roNumConstantFolding RuleOpts
env)
[CoreExpr
arg1,CoreExpr
arg2] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Maybe CoreExpr -> RuleM CoreExpr
forall a. Maybe a -> RuleM a
liftMaybe
(Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
andFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops
Maybe CoreExpr -> Maybe CoreExpr -> Maybe CoreExpr
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
andFoldingRules' Platform
platform CoreExpr
arg2 CoreExpr
arg1 NumOps
num_ops)
orFoldingRules :: NumOps -> RuleM CoreExpr
orFoldingRules :: NumOps -> RuleM CoreExpr
orFoldingRules NumOps
num_ops = do
RuleOpts
env <- RuleM RuleOpts
getRuleOpts
Bool -> RuleM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RuleOpts -> Bool
roNumConstantFolding RuleOpts
env)
[CoreExpr
arg1,CoreExpr
arg2] <- RuleM [CoreExpr]
getArgs
Platform
platform <- RuleM Platform
getPlatform
Maybe CoreExpr -> RuleM CoreExpr
forall a. Maybe a -> RuleM a
liftMaybe
(Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
orFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops
Maybe CoreExpr -> Maybe CoreExpr -> Maybe CoreExpr
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
orFoldingRules' Platform
platform CoreExpr
arg2 CoreExpr
arg1 NumOps
num_ops)
addFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
addFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
addFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops = case (CoreExpr
arg1, CoreExpr
arg2) of
(CoreExpr
x, NumOps -> CoreExpr -> Maybe CoreExpr
is_neg NumOps
num_ops -> Just CoreExpr
y)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
y)
(L Integer
l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l2,CoreExpr
x))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
x)
(L Integer
l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l2,CoreExpr
x))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
x)
(L Integer
l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
x,L Integer
l2))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
x)
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
y,L Integer
l2))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`sub` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
y,L Integer
l2))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
y CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
x))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
x,L Integer
l1), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
y,L Integer
l2))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
0Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y))
(CoreExpr, CoreExpr)
_ | Just Integer
l1 <- NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
is_expr_mul NumOps
num_ops CoreExpr
arg1 CoreExpr
arg2
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
arg1)
(CoreExpr, CoreExpr)
_ | Just Integer
l1 <- NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
is_expr_mul NumOps
num_ops CoreExpr
arg2 CoreExpr
arg1
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
arg2)
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_mul NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
is_expr_mul NumOps
num_ops CoreExpr
x -> Just Integer
l2)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
x)
(CoreExpr
_, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL Integer
l1 CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
arg1 CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y))
(CoreExpr
_, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l1,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL Integer
l1 CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
arg1 CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
y))
(CoreExpr
_, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
y,L Integer
l1))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just ((CoreExpr
arg1 CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL Integer
l1)
(CoreExpr, CoreExpr)
_ -> Maybe CoreExpr
forall a. Maybe a
Nothing
where
mkL :: Integer -> CoreExpr
mkL = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr)
-> (Integer -> Literal) -> Integer -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> NumOps -> Integer -> Literal
mkNumLiteral Platform
platform NumOps
num_ops
add :: CoreExpr -> CoreExpr -> CoreExpr
add CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (NumOps -> PrimOp
numAdd NumOps
num_ops) CoreExpr
y
sub :: CoreExpr -> CoreExpr -> CoreExpr
sub CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (NumOps -> PrimOp
numSub NumOps
num_ops) CoreExpr
y
mul :: CoreExpr -> CoreExpr -> CoreExpr
mul CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (NumOps -> PrimOp
numMul NumOps
num_ops) CoreExpr
y
subFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
subFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
subFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops = case (CoreExpr
arg1,CoreExpr
arg2) of
(CoreExpr
x, NumOps -> CoreExpr -> Maybe CoreExpr
is_neg NumOps
num_ops -> Just CoreExpr
y)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y)
(L Integer
l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l2,CoreExpr
x))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
x)
(L Integer
l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l2,CoreExpr
x))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
x)
(L Integer
l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
x, L Integer
l2))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
x)
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), L Integer
l2)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
x)
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l1,CoreExpr
x), L Integer
l2)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
x)
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
x,L Integer
l1), L Integer
l2)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2))
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
y,L Integer
l2))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`sub` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
x,L Integer
l1), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
0Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
y CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
x))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
y,L Integer
l2))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`sub` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
x,L Integer
l1), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
0Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
x,L Integer
l1), NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
y,L Integer
l2))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l1) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
y))
(CoreExpr, CoreExpr)
_ | Just Integer
l1 <- NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
is_expr_mul NumOps
num_ops CoreExpr
arg1 CoreExpr
arg2
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l1) CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
arg1)
(CoreExpr, CoreExpr)
_ | Just Integer
l1 <- NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
is_expr_mul NumOps
num_ops CoreExpr
arg2 CoreExpr
arg1
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
arg2)
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_mul NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
is_expr_mul NumOps
num_ops CoreExpr
x -> Just Integer
l2)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
x)
(CoreExpr
_, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just ((CoreExpr
arg1 CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
y) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL Integer
l1)
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), CoreExpr
_)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL Integer
l1 CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
arg2))
(CoreExpr
_, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l1,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just ((CoreExpr
arg1 CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
y) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL Integer
l1)
(CoreExpr
_, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
y,L Integer
l1))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL Integer
l1 CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
arg1 CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
y))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l1,CoreExpr
x), CoreExpr
_)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL Integer
l1 CoreExpr -> CoreExpr -> CoreExpr
`sub` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`add` CoreExpr
arg2))
(NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
x,L Integer
l1), CoreExpr
_)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just ((CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`sub` CoreExpr
arg2) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL Integer
l1)
(CoreExpr, CoreExpr)
_ -> Maybe CoreExpr
forall a. Maybe a
Nothing
where
mkL :: Integer -> CoreExpr
mkL = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr)
-> (Integer -> Literal) -> Integer -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> NumOps -> Integer -> Literal
mkNumLiteral Platform
platform NumOps
num_ops
add :: CoreExpr -> CoreExpr -> CoreExpr
add CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (NumOps -> PrimOp
numAdd NumOps
num_ops) CoreExpr
y
sub :: CoreExpr -> CoreExpr -> CoreExpr
sub CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (NumOps -> PrimOp
numSub NumOps
num_ops) CoreExpr
y
mul :: CoreExpr -> CoreExpr -> CoreExpr
mul CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (NumOps -> PrimOp
numMul NumOps
num_ops) CoreExpr
y
mulFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
mulFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
mulFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops = case (CoreExpr
arg1,CoreExpr
arg2) of
(NumOps -> CoreExpr -> Maybe CoreExpr
is_neg NumOps
num_ops -> Just CoreExpr
x, NumOps -> CoreExpr -> Maybe CoreExpr
is_neg NumOps
num_ops -> Just CoreExpr
y)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
y)
(L Integer
l1, NumOps -> CoreExpr -> Maybe CoreExpr
is_neg NumOps
num_ops -> Just CoreExpr
x)
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (-Integer
l1) CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
x)
(L Integer
l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_mul NumOps
num_ops -> Just (Integer
l2,CoreExpr
x))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
x)
(L Integer
l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops -> Just (Integer
l2,CoreExpr
x))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`add` (CoreExpr
arg1 CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
x))
(L Integer
l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (L Integer
l2,CoreExpr
x))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`sub` (CoreExpr
arg1 CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
x))
(L Integer
l1, NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops -> Just (CoreExpr
x, L Integer
l2))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just ((CoreExpr
arg1 CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
x) CoreExpr -> CoreExpr -> CoreExpr
`sub` Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
l2))
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_mul NumOps
num_ops -> Just (Integer
l1,CoreExpr
x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_mul NumOps
num_ops -> Just (Integer
l2,CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`mul` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`mul` CoreExpr
y))
(CoreExpr, CoreExpr)
_ -> Maybe CoreExpr
forall a. Maybe a
Nothing
where
mkL :: Integer -> CoreExpr
mkL = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr)
-> (Integer -> Literal) -> Integer -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> NumOps -> Integer -> Literal
mkNumLiteral Platform
platform NumOps
num_ops
add :: CoreExpr -> CoreExpr -> CoreExpr
add CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (NumOps -> PrimOp
numAdd NumOps
num_ops) CoreExpr
y
sub :: CoreExpr -> CoreExpr -> CoreExpr
sub CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (NumOps -> PrimOp
numSub NumOps
num_ops) CoreExpr
y
mul :: CoreExpr -> CoreExpr -> CoreExpr
mul CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (NumOps -> PrimOp
numMul NumOps
num_ops) CoreExpr
y
andFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
andFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
andFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops = case (CoreExpr
arg1, CoreExpr
arg2) of
(L Integer
l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_and NumOps
num_ops -> Just (Integer
l2, CoreExpr
x))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`and` CoreExpr
x)
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_and NumOps
num_ops -> Just (Integer
l1, CoreExpr
x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_and NumOps
num_ops -> Just (Integer
l2, CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`and` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`and` CoreExpr
y))
(CoreExpr, CoreExpr)
_ -> Maybe CoreExpr
forall a. Maybe a
Nothing
where
mkL :: Integer -> CoreExpr
mkL = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr)
-> (Integer -> Literal) -> Integer -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> NumOps -> Integer -> Literal
mkNumLiteral Platform
platform NumOps
num_ops
and :: CoreExpr -> CoreExpr -> CoreExpr
and CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (Maybe PrimOp -> PrimOp
forall a. HasCallStack => Maybe a -> a
fromJust (NumOps -> Maybe PrimOp
numAnd NumOps
num_ops)) CoreExpr
y
orFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
orFoldingRules' :: Platform -> CoreExpr -> CoreExpr -> NumOps -> Maybe CoreExpr
orFoldingRules' Platform
platform CoreExpr
arg1 CoreExpr
arg2 NumOps
num_ops = case (CoreExpr
arg1, CoreExpr
arg2) of
(L Integer
l1, NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_or NumOps
num_ops -> Just (Integer
l2, CoreExpr
x))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`or` CoreExpr
x)
(NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_or NumOps
num_ops -> Just (Integer
l1, CoreExpr
x), NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_or NumOps
num_ops -> Just (Integer
l2, CoreExpr
y))
-> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just (Integer -> CoreExpr
mkL (Integer
l1 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
l2) CoreExpr -> CoreExpr -> CoreExpr
`or` (CoreExpr
x CoreExpr -> CoreExpr -> CoreExpr
`or` CoreExpr
y))
(CoreExpr, CoreExpr)
_ -> Maybe CoreExpr
forall a. Maybe a
Nothing
where
mkL :: Integer -> CoreExpr
mkL = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit (Literal -> CoreExpr)
-> (Integer -> Literal) -> Integer -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> NumOps -> Integer -> Literal
mkNumLiteral Platform
platform NumOps
num_ops
or :: CoreExpr -> CoreExpr -> CoreExpr
or CoreExpr
x CoreExpr
y = CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp CoreExpr
x (Maybe PrimOp -> PrimOp
forall a. HasCallStack => Maybe a -> a
fromJust (NumOps -> Maybe PrimOp
numOr NumOps
num_ops)) CoreExpr
y
is_binop :: PrimOp -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)
is_binop :: PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop PrimOp
op CoreExpr
e = case CoreExpr
e of
BinOpApp CoreExpr
x PrimOp
op' CoreExpr
y | PrimOp
op PrimOp -> PrimOp -> Bool
forall a. Eq a => a -> a -> Bool
== PrimOp
op' -> (CoreExpr, CoreExpr) -> Maybe (CoreExpr, CoreExpr)
forall a. a -> Maybe a
Just (CoreExpr
x,CoreExpr
y)
CoreExpr
_ -> Maybe (CoreExpr, CoreExpr)
forall a. Maybe a
Nothing
is_op :: PrimOp -> CoreExpr -> Maybe (Arg CoreBndr)
is_op :: PrimOp -> CoreExpr -> Maybe CoreExpr
is_op PrimOp
op CoreExpr
e = case CoreExpr
e of
App (OpVal PrimOp
op') CoreExpr
x | PrimOp
op PrimOp -> PrimOp -> Bool
forall a. Eq a => a -> a -> Bool
== PrimOp
op' -> CoreExpr -> Maybe CoreExpr
forall a. a -> Maybe a
Just CoreExpr
x
CoreExpr
_ -> Maybe CoreExpr
forall a. Maybe a
Nothing
is_add, is_sub, is_mul, is_and, is_or :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)
is_add :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_add NumOps
num_ops CoreExpr
e = PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop (NumOps -> PrimOp
numAdd NumOps
num_ops) CoreExpr
e
is_sub :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_sub NumOps
num_ops CoreExpr
e = PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop (NumOps -> PrimOp
numSub NumOps
num_ops) CoreExpr
e
is_mul :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_mul NumOps
num_ops CoreExpr
e = PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop (NumOps -> PrimOp
numMul NumOps
num_ops) CoreExpr
e
is_and :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_and NumOps
num_ops CoreExpr
e = NumOps -> Maybe PrimOp
numAnd NumOps
num_ops Maybe PrimOp
-> (PrimOp -> Maybe (CoreExpr, CoreExpr))
-> Maybe (CoreExpr, CoreExpr)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PrimOp
op -> PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop PrimOp
op CoreExpr
e
is_or :: NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_or NumOps
num_ops CoreExpr
e = NumOps -> Maybe PrimOp
numOr NumOps
num_ops Maybe PrimOp
-> (PrimOp -> Maybe (CoreExpr, CoreExpr))
-> Maybe (CoreExpr, CoreExpr)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PrimOp
op -> PrimOp -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_binop PrimOp
op CoreExpr
e
is_neg :: NumOps -> CoreExpr -> Maybe (Arg CoreBndr)
is_neg :: NumOps -> CoreExpr -> Maybe CoreExpr
is_neg NumOps
num_ops CoreExpr
e = NumOps -> Maybe PrimOp
numNeg NumOps
num_ops Maybe PrimOp -> (PrimOp -> Maybe CoreExpr) -> Maybe CoreExpr
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PrimOp
op -> PrimOp -> CoreExpr -> Maybe CoreExpr
is_op PrimOp
op CoreExpr
e
is_lit_add, is_lit_mul, is_lit_and, is_lit_or :: NumOps -> CoreExpr -> Maybe (Integer, Arg CoreBndr)
is_lit_add :: NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_add NumOps
num_ops CoreExpr
e = (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
-> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_add NumOps
num_ops CoreExpr
e
is_lit_mul :: NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_mul NumOps
num_ops CoreExpr
e = (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
-> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_mul NumOps
num_ops CoreExpr
e
is_lit_and :: NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_and NumOps
num_ops CoreExpr
e = (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
-> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_and NumOps
num_ops CoreExpr
e
is_lit_or :: NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_or NumOps
num_ops CoreExpr
e = (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
-> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
is_or NumOps
num_ops CoreExpr
e
is_lit' :: (NumOps -> CoreExpr -> Maybe (Arg CoreBndr, Arg CoreBndr)) -> NumOps -> CoreExpr -> Maybe (Integer, Arg CoreBndr)
is_lit' :: (NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr))
-> NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit' NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
f NumOps
num_ops CoreExpr
e = case NumOps -> CoreExpr -> Maybe (CoreExpr, CoreExpr)
f NumOps
num_ops CoreExpr
e of
Just (L Integer
l, CoreExpr
x ) -> (Integer, CoreExpr) -> Maybe (Integer, CoreExpr)
forall a. a -> Maybe a
Just (Integer
l,CoreExpr
x)
Just (CoreExpr
x , L Integer
l) -> (Integer, CoreExpr) -> Maybe (Integer, CoreExpr)
forall a. a -> Maybe a
Just (Integer
l,CoreExpr
x)
Maybe (CoreExpr, CoreExpr)
_ -> Maybe (Integer, CoreExpr)
forall a. Maybe a
Nothing
is_expr_mul :: NumOps -> Expr CoreBndr -> Expr CoreBndr -> Maybe Integer
is_expr_mul :: NumOps -> CoreExpr -> CoreExpr -> Maybe Integer
is_expr_mul NumOps
num_ops CoreExpr
x CoreExpr
e = if
| CoreExpr
x CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
e
-> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1
| Just (Integer
k,CoreExpr
x') <- NumOps -> CoreExpr -> Maybe (Integer, CoreExpr)
is_lit_mul NumOps
num_ops CoreExpr
e
, CoreExpr
x CoreExpr -> CoreExpr -> Bool
forall b. Expr b -> Expr b -> Bool
`cheapEqExpr` CoreExpr
x'
-> Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
k
| Bool
otherwise
-> Maybe Integer
forall a. Maybe a
Nothing
pattern BinOpApp :: Arg CoreBndr -> PrimOp -> Arg CoreBndr -> CoreExpr
pattern $mBinOpApp :: forall {r}.
CoreExpr
-> (CoreExpr -> PrimOp -> CoreExpr -> r) -> ((# #) -> r) -> r
$bBinOpApp :: CoreExpr -> PrimOp -> CoreExpr -> CoreExpr
BinOpApp x op y = OpVal op `App` x `App` y
pattern OpVal:: PrimOp -> Arg CoreBndr
pattern $mOpVal :: forall {r}. CoreExpr -> (PrimOp -> r) -> ((# #) -> r) -> r
$bOpVal :: PrimOp -> CoreExpr
OpVal op <- Var (isPrimOpId_maybe -> Just op) where
OpVal PrimOp
op = Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
op)
pattern L :: Integer -> Arg CoreBndr
pattern $mL :: forall {r}. CoreExpr -> (Integer -> r) -> ((# #) -> r) -> r
L i <- Lit (LitNumber _ i)
data NumOps = NumOps
{ NumOps -> PrimOp
numAdd :: !PrimOp
, NumOps -> PrimOp
numSub :: !PrimOp
, NumOps -> PrimOp
numMul :: !PrimOp
, NumOps -> Maybe PrimOp
numAnd :: !(Maybe PrimOp)
, NumOps -> Maybe PrimOp
numOr :: !(Maybe PrimOp)
, NumOps -> Maybe PrimOp
numNeg :: !(Maybe PrimOp)
, NumOps -> LitNumType
numLitType :: !LitNumType
}
mkNumLiteral :: Platform -> NumOps -> Integer -> Literal
mkNumLiteral :: Platform -> NumOps -> Integer -> Literal
mkNumLiteral Platform
platform NumOps
ops Integer
i = Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform (NumOps -> LitNumType
numLitType NumOps
ops) Integer
i
int8Ops :: NumOps
int8Ops :: NumOps
int8Ops = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
Int8AddOp
, numSub :: PrimOp
numSub = PrimOp
Int8SubOp
, numMul :: PrimOp
numMul = PrimOp
Int8MulOp
, numLitType :: LitNumType
numLitType = LitNumType
LitNumInt8
, numAnd :: Maybe PrimOp
numAnd = Maybe PrimOp
forall a. Maybe a
Nothing
, numOr :: Maybe PrimOp
numOr = Maybe PrimOp
forall a. Maybe a
Nothing
, numNeg :: Maybe PrimOp
numNeg = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Int8NegOp
}
word8Ops :: NumOps
word8Ops :: NumOps
word8Ops = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
Word8AddOp
, numSub :: PrimOp
numSub = PrimOp
Word8SubOp
, numMul :: PrimOp
numMul = PrimOp
Word8MulOp
, numAnd :: Maybe PrimOp
numAnd = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Word8AndOp
, numOr :: Maybe PrimOp
numOr = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Word8OrOp
, numNeg :: Maybe PrimOp
numNeg = Maybe PrimOp
forall a. Maybe a
Nothing
, numLitType :: LitNumType
numLitType = LitNumType
LitNumWord8
}
int16Ops :: NumOps
int16Ops :: NumOps
int16Ops = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
Int16AddOp
, numSub :: PrimOp
numSub = PrimOp
Int16SubOp
, numMul :: PrimOp
numMul = PrimOp
Int16MulOp
, numLitType :: LitNumType
numLitType = LitNumType
LitNumInt16
, numAnd :: Maybe PrimOp
numAnd = Maybe PrimOp
forall a. Maybe a
Nothing
, numOr :: Maybe PrimOp
numOr = Maybe PrimOp
forall a. Maybe a
Nothing
, numNeg :: Maybe PrimOp
numNeg = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Int16NegOp
}
word16Ops :: NumOps
word16Ops :: NumOps
word16Ops = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
Word16AddOp
, numSub :: PrimOp
numSub = PrimOp
Word16SubOp
, numMul :: PrimOp
numMul = PrimOp
Word16MulOp
, numAnd :: Maybe PrimOp
numAnd = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Word16AndOp
, numOr :: Maybe PrimOp
numOr = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Word16OrOp
, numNeg :: Maybe PrimOp
numNeg = Maybe PrimOp
forall a. Maybe a
Nothing
, numLitType :: LitNumType
numLitType = LitNumType
LitNumWord16
}
int32Ops :: NumOps
int32Ops :: NumOps
int32Ops = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
Int32AddOp
, numSub :: PrimOp
numSub = PrimOp
Int32SubOp
, numMul :: PrimOp
numMul = PrimOp
Int32MulOp
, numLitType :: LitNumType
numLitType = LitNumType
LitNumInt32
, numAnd :: Maybe PrimOp
numAnd = Maybe PrimOp
forall a. Maybe a
Nothing
, numOr :: Maybe PrimOp
numOr = Maybe PrimOp
forall a. Maybe a
Nothing
, numNeg :: Maybe PrimOp
numNeg = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Int32NegOp
}
word32Ops :: NumOps
word32Ops :: NumOps
word32Ops = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
Word32AddOp
, numSub :: PrimOp
numSub = PrimOp
Word32SubOp
, numMul :: PrimOp
numMul = PrimOp
Word32MulOp
, numAnd :: Maybe PrimOp
numAnd = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Word32AndOp
, numOr :: Maybe PrimOp
numOr = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Word32OrOp
, numNeg :: Maybe PrimOp
numNeg = Maybe PrimOp
forall a. Maybe a
Nothing
, numLitType :: LitNumType
numLitType = LitNumType
LitNumWord32
}
int64Ops :: NumOps
int64Ops :: NumOps
int64Ops = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
Int64AddOp
, numSub :: PrimOp
numSub = PrimOp
Int64SubOp
, numMul :: PrimOp
numMul = PrimOp
Int64MulOp
, numLitType :: LitNumType
numLitType = LitNumType
LitNumInt64
, numAnd :: Maybe PrimOp
numAnd = Maybe PrimOp
forall a. Maybe a
Nothing
, numOr :: Maybe PrimOp
numOr = Maybe PrimOp
forall a. Maybe a
Nothing
, numNeg :: Maybe PrimOp
numNeg = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Int64NegOp
}
word64Ops :: NumOps
word64Ops :: NumOps
word64Ops = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
Word64AddOp
, numSub :: PrimOp
numSub = PrimOp
Word64SubOp
, numMul :: PrimOp
numMul = PrimOp
Word64MulOp
, numAnd :: Maybe PrimOp
numAnd = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Word64AndOp
, numOr :: Maybe PrimOp
numOr = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
Word64OrOp
, numNeg :: Maybe PrimOp
numNeg = Maybe PrimOp
forall a. Maybe a
Nothing
, numLitType :: LitNumType
numLitType = LitNumType
LitNumWord64
}
intOps :: NumOps
intOps :: NumOps
intOps = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
IntAddOp
, numSub :: PrimOp
numSub = PrimOp
IntSubOp
, numMul :: PrimOp
numMul = PrimOp
IntMulOp
, numAnd :: Maybe PrimOp
numAnd = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
IntAndOp
, numOr :: Maybe PrimOp
numOr = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
IntOrOp
, numNeg :: Maybe PrimOp
numNeg = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
IntNegOp
, numLitType :: LitNumType
numLitType = LitNumType
LitNumInt
}
wordOps :: NumOps
wordOps :: NumOps
wordOps = NumOps
{ numAdd :: PrimOp
numAdd = PrimOp
WordAddOp
, numSub :: PrimOp
numSub = PrimOp
WordSubOp
, numMul :: PrimOp
numMul = PrimOp
WordMulOp
, numAnd :: Maybe PrimOp
numAnd = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
WordAndOp
, numOr :: Maybe PrimOp
numOr = PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
WordOrOp
, numNeg :: Maybe PrimOp
numNeg = Maybe PrimOp
forall a. Maybe a
Nothing
, numLitType :: LitNumType
numLitType = LitNumType
LitNumWord
}
caseRules :: Platform
-> CoreExpr
-> Maybe ( CoreExpr
, AltCon -> Maybe AltCon
, Id -> CoreExpr)
caseRules :: Platform
-> CoreExpr
-> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
caseRules Platform
platform (App (App (Var Id
f) CoreExpr
v) (Lit Literal
l))
| Just PrimOp
op <- Id -> Maybe PrimOp
isPrimOpId_maybe Id
f
, LitNumber LitNumType
_ Integer
x <- Literal
l
, Just Integer -> Integer
adjust_lit <- PrimOp -> Integer -> Maybe (Integer -> Integer)
adjustDyadicRight PrimOp
op Integer
x
= (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
-> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
forall a. a -> Maybe a
Just (CoreExpr
v, Platform -> (Integer -> Integer) -> AltCon -> Maybe AltCon
tx_lit_con Platform
platform Integer -> Integer
adjust_lit
, \Id
v -> (CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
f) (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
v)) (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
l)))
caseRules Platform
platform (App (App (Var Id
f) (Lit Literal
l)) CoreExpr
v)
| Just PrimOp
op <- Id -> Maybe PrimOp
isPrimOpId_maybe Id
f
, LitNumber LitNumType
_ Integer
x <- Literal
l
, Just Integer -> Integer
adjust_lit <- Integer -> PrimOp -> Maybe (Integer -> Integer)
adjustDyadicLeft Integer
x PrimOp
op
= (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
-> Maybe (CoreExpr, AltCon -> Maybe AltCon, Id -> CoreExpr)
forall a. a -> Maybe a
Just (CoreExpr
v, Platform -> (Integer -> Integer) -> AltCon -> Maybe AltCon
tx_lit_con Platform
platform Integer -> Integer
adjust_lit
, \Id
v -> (CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
f) (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
l)) (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
v)))
caseRules Platform
platform (App (Var Id
f) CoreExpr
v )
| 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))
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)))
caseRules Platform
_ (App (App (Var Id
f) (Type Type
ty)) CoreExpr
v)
| Just PrimOp
DataToTagOp <- Id -> Maybe PrimOp
isPrimOpId_maybe Id
f
, Just (TyCon
tc, [Type]
_) <- HasCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
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, Type -> AltCon -> Maybe AltCon
tx_con_dtt Type
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) (Type -> CoreExpr
forall b. Type -> Expr b
Type Type
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
ppr AltCon
alt)
adjustDyadicRight :: PrimOp -> Integer -> Maybe (Integer -> Integer)
adjustDyadicRight :: PrimOp -> Integer -> Maybe (Integer -> Integer)
adjustDyadicRight PrimOp
op Integer
lit
= case PrimOp
op of
PrimOp
WordAddOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
lit )
PrimOp
IntAddOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
lit )
PrimOp
WordSubOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
lit )
PrimOp
IntSubOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
lit )
PrimOp
WordXorOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
y Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
lit)
PrimOp
IntXorOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
y Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
lit)
PrimOp
_ -> Maybe (Integer -> Integer)
forall a. Maybe a
Nothing
adjustDyadicLeft :: Integer -> PrimOp -> Maybe (Integer -> Integer)
adjustDyadicLeft :: Integer -> PrimOp -> Maybe (Integer -> Integer)
adjustDyadicLeft Integer
lit PrimOp
op
= case PrimOp
op of
PrimOp
WordAddOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
lit )
PrimOp
IntAddOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
lit )
PrimOp
WordSubOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
litInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
y )
PrimOp
IntSubOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
litInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
y )
PrimOp
WordXorOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
y Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
lit)
PrimOp
IntXorOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer
y Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
lit)
PrimOp
_ -> Maybe (Integer -> Integer)
forall a. Maybe a
Nothing
adjustUnary :: PrimOp -> Maybe (Integer -> Integer)
adjustUnary :: PrimOp -> Maybe (Integer -> Integer)
adjustUnary PrimOp
op
= case PrimOp
op of
PrimOp
WordNotOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer -> Integer
forall a. Bits a => a -> a
complement Integer
y)
PrimOp
IntNotOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer -> Integer
forall a. Bits a => a -> a
complement Integer
y)
PrimOp
IntNegOp -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just (\Integer
y -> Integer -> Integer
forall a. Num a => a -> a
negate Integer
y )
PrimOp
_ -> Maybe (Integer -> Integer)
forall a. Maybe a
Nothing
tx_con_tte :: Platform -> AltCon -> Maybe AltCon
tx_con_tte :: Platform -> AltCon -> Maybe AltCon
tx_con_tte Platform
_ AltCon
DEFAULT = AltCon -> Maybe AltCon
forall a. a -> Maybe a
Just AltCon
DEFAULT
tx_con_tte Platform
_ alt :: AltCon
alt@(LitAlt {}) = String -> SDoc -> Maybe AltCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"caseRules" (AltCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltCon
alt)
tx_con_tte Platform
platform (DataAlt DataCon
dc)
= AltCon -> Maybe AltCon
forall a. a -> Maybe a
Just (AltCon -> Maybe AltCon) -> AltCon -> Maybe AltCon
forall a b. (a -> b) -> a -> b
$ Literal -> AltCon
LitAlt (Literal -> AltCon) -> Literal -> AltCon
forall a b. (a -> b) -> a -> b
$ Platform -> Integer -> Literal
mkLitInt Platform
platform (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ ConTagZ -> Integer
forall a. Integral a => a -> Integer
toInteger (ConTagZ -> Integer) -> ConTagZ -> Integer
forall a b. (a -> b) -> a -> b
$ DataCon -> ConTagZ
dataConTagZ DataCon
dc
tx_con_dtt :: Type -> AltCon -> Maybe AltCon
tx_con_dtt :: Type -> AltCon -> Maybe AltCon
tx_con_dtt Type
_ AltCon
DEFAULT = AltCon -> Maybe AltCon
forall a. a -> Maybe a
Just AltCon
DEFAULT
tx_con_dtt Type
ty (LitAlt (LitNumber LitNumType
LitNumInt Integer
i))
| ConTagZ
tag ConTagZ -> ConTagZ -> Bool
forall a. Ord a => a -> a -> Bool
>= ConTagZ
0
, ConTagZ
tag ConTagZ -> ConTagZ -> Bool
forall a. Ord a => a -> a -> Bool
< ConTagZ
n_data_cons
= AltCon -> Maybe AltCon
forall a. a -> Maybe a
Just (DataCon -> AltCon
DataAlt ([DataCon]
data_cons [DataCon] -> ConTagZ -> DataCon
forall a. HasCallStack => [a] -> ConTagZ -> a
!! ConTagZ
tag))
| Bool
otherwise
= Maybe AltCon
forall a. Maybe a
Nothing
where
tag :: ConTagZ
tag = Integer -> ConTagZ
forall a. Num a => Integer -> a
fromInteger Integer
i :: ConTagZ
tc :: TyCon
tc = (() :: Constraint) => Type -> TyCon
Type -> TyCon
tyConAppTyCon Type
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 Type
_ AltCon
alt = String -> SDoc -> Maybe AltCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"caseRules" (AltCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltCon
alt)