-- editorconfig-checker-disable-file
{- |
Adapted from 'Data.SafeInt' to perform saturating arithmetic (i.e. returning max or min bounds) instead of throwing on overflow.

This is not quite as fast as using 'Int' or 'Int64' directly, but we need the safety.
-}
{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE MagicHash      #-}
{-# LANGUAGE UnboxedTuples  #-}

module Data.SatInt
    ( -- Not exporting the constructor, so that 'coerce' doesn't work, see 'unsafeToSatInt'.
      SatInt (unSatInt)
    , unsafeToSatInt
    , fromSatInt
    ) where

import Codec.Serialise (Serialise)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON)
import Data.Bits
import Data.Csv
import Data.Primitive (Prim)
import GHC.Base
import GHC.Generics
import GHC.Real
import Language.Haskell.TH.Syntax (Lift)
import NoThunks.Class

newtype SatInt = SI { SatInt -> Int
unSatInt :: Int }
    deriving newtype (Int -> SatInt -> ShowS
[SatInt] -> ShowS
SatInt -> String
(Int -> SatInt -> ShowS)
-> (SatInt -> String) -> ([SatInt] -> ShowS) -> Show SatInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SatInt -> ShowS
showsPrec :: Int -> SatInt -> ShowS
$cshow :: SatInt -> String
show :: SatInt -> String
$cshowList :: [SatInt] -> ShowS
showList :: [SatInt] -> ShowS
Show, ReadPrec [SatInt]
ReadPrec SatInt
Int -> ReadS SatInt
ReadS [SatInt]
(Int -> ReadS SatInt)
-> ReadS [SatInt]
-> ReadPrec SatInt
-> ReadPrec [SatInt]
-> Read SatInt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SatInt
readsPrec :: Int -> ReadS SatInt
$creadList :: ReadS [SatInt]
readList :: ReadS [SatInt]
$creadPrec :: ReadPrec SatInt
readPrec :: ReadPrec SatInt
$creadListPrec :: ReadPrec [SatInt]
readListPrec :: ReadPrec [SatInt]
Read, SatInt -> SatInt -> Bool
(SatInt -> SatInt -> Bool)
-> (SatInt -> SatInt -> Bool) -> Eq SatInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SatInt -> SatInt -> Bool
== :: SatInt -> SatInt -> Bool
$c/= :: SatInt -> SatInt -> Bool
/= :: SatInt -> SatInt -> Bool
Eq, Eq SatInt
Eq SatInt =>
(SatInt -> SatInt -> Ordering)
-> (SatInt -> SatInt -> Bool)
-> (SatInt -> SatInt -> Bool)
-> (SatInt -> SatInt -> Bool)
-> (SatInt -> SatInt -> Bool)
-> (SatInt -> SatInt -> SatInt)
-> (SatInt -> SatInt -> SatInt)
-> Ord SatInt
SatInt -> SatInt -> Bool
SatInt -> SatInt -> Ordering
SatInt -> SatInt -> SatInt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SatInt -> SatInt -> Ordering
compare :: SatInt -> SatInt -> Ordering
$c< :: SatInt -> SatInt -> Bool
< :: SatInt -> SatInt -> Bool
$c<= :: SatInt -> SatInt -> Bool
<= :: SatInt -> SatInt -> Bool
$c> :: SatInt -> SatInt -> Bool
> :: SatInt -> SatInt -> Bool
$c>= :: SatInt -> SatInt -> Bool
>= :: SatInt -> SatInt -> Bool
$cmax :: SatInt -> SatInt -> SatInt
max :: SatInt -> SatInt -> SatInt
$cmin :: SatInt -> SatInt -> SatInt
min :: SatInt -> SatInt -> SatInt
Ord, SatInt
SatInt -> SatInt -> Bounded SatInt
forall a. a -> a -> Bounded a
$cminBound :: SatInt
minBound :: SatInt
$cmaxBound :: SatInt
maxBound :: SatInt
Bounded, SatInt -> ()
(SatInt -> ()) -> NFData SatInt
forall a. (a -> ()) -> NFData a
$crnf :: SatInt -> ()
rnf :: SatInt -> ()
NFData, Eq SatInt
SatInt
Eq SatInt =>
(SatInt -> SatInt -> SatInt)
-> (SatInt -> SatInt -> SatInt)
-> (SatInt -> SatInt -> SatInt)
-> (SatInt -> SatInt)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int -> SatInt)
-> SatInt
-> (Int -> SatInt)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int -> Bool)
-> (SatInt -> Maybe Int)
-> (SatInt -> Int)
-> (SatInt -> Bool)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int -> SatInt)
-> (SatInt -> Int)
-> Bits SatInt
Int -> SatInt
SatInt -> Bool
SatInt -> Int
SatInt -> Maybe Int
SatInt -> SatInt
SatInt -> Int -> Bool
SatInt -> Int -> SatInt
SatInt -> SatInt -> SatInt
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: SatInt -> SatInt -> SatInt
.&. :: SatInt -> SatInt -> SatInt
$c.|. :: SatInt -> SatInt -> SatInt
.|. :: SatInt -> SatInt -> SatInt
$cxor :: SatInt -> SatInt -> SatInt
xor :: SatInt -> SatInt -> SatInt
$ccomplement :: SatInt -> SatInt
complement :: SatInt -> SatInt
$cshift :: SatInt -> Int -> SatInt
shift :: SatInt -> Int -> SatInt
$crotate :: SatInt -> Int -> SatInt
rotate :: SatInt -> Int -> SatInt
$czeroBits :: SatInt
zeroBits :: SatInt
$cbit :: Int -> SatInt
bit :: Int -> SatInt
$csetBit :: SatInt -> Int -> SatInt
setBit :: SatInt -> Int -> SatInt
$cclearBit :: SatInt -> Int -> SatInt
clearBit :: SatInt -> Int -> SatInt
$ccomplementBit :: SatInt -> Int -> SatInt
complementBit :: SatInt -> Int -> SatInt
$ctestBit :: SatInt -> Int -> Bool
testBit :: SatInt -> Int -> Bool
$cbitSizeMaybe :: SatInt -> Maybe Int
bitSizeMaybe :: SatInt -> Maybe Int
$cbitSize :: SatInt -> Int
bitSize :: SatInt -> Int
$cisSigned :: SatInt -> Bool
isSigned :: SatInt -> Bool
$cshiftL :: SatInt -> Int -> SatInt
shiftL :: SatInt -> Int -> SatInt
$cunsafeShiftL :: SatInt -> Int -> SatInt
unsafeShiftL :: SatInt -> Int -> SatInt
$cshiftR :: SatInt -> Int -> SatInt
shiftR :: SatInt -> Int -> SatInt
$cunsafeShiftR :: SatInt -> Int -> SatInt
unsafeShiftR :: SatInt -> Int -> SatInt
$crotateL :: SatInt -> Int -> SatInt
rotateL :: SatInt -> Int -> SatInt
$crotateR :: SatInt -> Int -> SatInt
rotateR :: SatInt -> Int -> SatInt
$cpopCount :: SatInt -> Int
popCount :: SatInt -> Int
Bits, Bits SatInt
Bits SatInt =>
(SatInt -> Int)
-> (SatInt -> Int) -> (SatInt -> Int) -> FiniteBits SatInt
SatInt -> Int
forall b.
Bits b =>
(b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
$cfiniteBitSize :: SatInt -> Int
finiteBitSize :: SatInt -> Int
$ccountLeadingZeros :: SatInt -> Int
countLeadingZeros :: SatInt -> Int
$ccountTrailingZeros :: SatInt -> Int
countTrailingZeros :: SatInt -> Int
FiniteBits, Addr# -> Int# -> SatInt
ByteArray# -> Int# -> SatInt
Proxy SatInt -> Int#
SatInt -> Int#
(Proxy SatInt -> Int#)
-> (SatInt -> Int#)
-> (Proxy SatInt -> Int#)
-> (SatInt -> Int#)
-> (ByteArray# -> Int# -> SatInt)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, SatInt #))
-> (forall s.
    MutableByteArray# s -> Int# -> SatInt -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> SatInt -> State# s -> State# s)
-> (Addr# -> Int# -> SatInt)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, SatInt #))
-> (forall s. Addr# -> Int# -> SatInt -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> SatInt -> State# s -> State# s)
-> Prim SatInt
forall s. Addr# -> Int# -> Int# -> SatInt -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, SatInt #)
forall s. Addr# -> Int# -> SatInt -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> SatInt -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, SatInt #)
forall s.
MutableByteArray# s -> Int# -> SatInt -> State# s -> State# s
forall a.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOfType# :: Proxy SatInt -> Int#
sizeOfType# :: Proxy SatInt -> Int#
$csizeOf# :: SatInt -> Int#
sizeOf# :: SatInt -> Int#
$calignmentOfType# :: Proxy SatInt -> Int#
alignmentOfType# :: Proxy SatInt -> Int#
$calignment# :: SatInt -> Int#
alignment# :: SatInt -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> SatInt
indexByteArray# :: ByteArray# -> Int# -> SatInt
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, SatInt #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, SatInt #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> SatInt -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> SatInt -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> SatInt -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> SatInt -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> SatInt
indexOffAddr# :: Addr# -> Int# -> SatInt
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, SatInt #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, SatInt #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> SatInt -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> SatInt -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> SatInt -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> SatInt -> State# s -> State# s
Prim)
    deriving stock ((forall (m :: * -> *). Quote m => SatInt -> m Exp)
-> (forall (m :: * -> *). Quote m => SatInt -> Code m SatInt)
-> Lift SatInt
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SatInt -> m Exp
forall (m :: * -> *). Quote m => SatInt -> Code m SatInt
$clift :: forall (m :: * -> *). Quote m => SatInt -> m Exp
lift :: forall (m :: * -> *). Quote m => SatInt -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => SatInt -> Code m SatInt
liftTyped :: forall (m :: * -> *). Quote m => SatInt -> Code m SatInt
Lift, (forall x. SatInt -> Rep SatInt x)
-> (forall x. Rep SatInt x -> SatInt) -> Generic SatInt
forall x. Rep SatInt x -> SatInt
forall x. SatInt -> Rep SatInt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SatInt -> Rep SatInt x
from :: forall x. SatInt -> Rep SatInt x
$cto :: forall x. Rep SatInt x -> SatInt
to :: forall x. Rep SatInt x -> SatInt
Generic)
    deriving (Maybe SatInt
Value -> Parser [SatInt]
Value -> Parser SatInt
(Value -> Parser SatInt)
-> (Value -> Parser [SatInt]) -> Maybe SatInt -> FromJSON SatInt
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SatInt
parseJSON :: Value -> Parser SatInt
$cparseJSONList :: Value -> Parser [SatInt]
parseJSONList :: Value -> Parser [SatInt]
$comittedField :: Maybe SatInt
omittedField :: Maybe SatInt
FromJSON, [SatInt] -> Encoding
[SatInt] -> Value
SatInt -> Bool
SatInt -> Encoding
SatInt -> Value
(SatInt -> Value)
-> (SatInt -> Encoding)
-> ([SatInt] -> Value)
-> ([SatInt] -> Encoding)
-> (SatInt -> Bool)
-> ToJSON SatInt
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SatInt -> Value
toJSON :: SatInt -> Value
$ctoEncoding :: SatInt -> Encoding
toEncoding :: SatInt -> Encoding
$ctoJSONList :: [SatInt] -> Value
toJSONList :: [SatInt] -> Value
$ctoEncodingList :: [SatInt] -> Encoding
toEncodingList :: [SatInt] -> Encoding
$comitField :: SatInt -> Bool
omitField :: SatInt -> Bool
ToJSON) via Int
    deriving Field -> Parser SatInt
(Field -> Parser SatInt) -> FromField SatInt
forall a. (Field -> Parser a) -> FromField a
$cparseField :: Field -> Parser SatInt
parseField :: Field -> Parser SatInt
FromField via Int  -- For reading cost model data from CSV input
    deriving [SatInt] -> Encoding
SatInt -> Encoding
(SatInt -> Encoding)
-> (forall s. Decoder s SatInt)
-> ([SatInt] -> Encoding)
-> (forall s. Decoder s [SatInt])
-> Serialise SatInt
forall s. Decoder s [SatInt]
forall s. Decoder s SatInt
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: SatInt -> Encoding
encode :: SatInt -> Encoding
$cdecode :: forall s. Decoder s SatInt
decode :: forall s. Decoder s SatInt
$cencodeList :: [SatInt] -> Encoding
encodeList :: [SatInt] -> Encoding
$cdecodeList :: forall s. Decoder s [SatInt]
decodeList :: forall s. Decoder s [SatInt]
Serialise via Int
    deriving anyclass Context -> SatInt -> IO (Maybe ThunkInfo)
Proxy SatInt -> String
(Context -> SatInt -> IO (Maybe ThunkInfo))
-> (Context -> SatInt -> IO (Maybe ThunkInfo))
-> (Proxy SatInt -> String)
-> NoThunks SatInt
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SatInt -> IO (Maybe ThunkInfo)
noThunks :: Context -> SatInt -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SatInt -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SatInt -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SatInt -> String
showTypeOf :: Proxy SatInt -> String
NoThunks

-- | Wrap an 'Int' as a 'SatInt'. This is unsafe because the 'Int' can be a result of an arbitrary
-- potentially underflowing/overflowing operation.
unsafeToSatInt :: Int -> SatInt
unsafeToSatInt :: Int -> SatInt
unsafeToSatInt = Int -> SatInt
SI
{-# INLINE unsafeToSatInt #-}

-- | An optimized version of @fromIntegral . unSatInt@.
fromSatInt :: forall a. Num a => SatInt -> a
fromSatInt :: forall a. Num a => SatInt -> a
fromSatInt = (Int -> a) -> SatInt -> a
forall a b. Coercible a b => a -> b
coerce (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> a)
{-# INLINE fromSatInt #-}

-- | In the `Num' instance, we plug in our own addition, multiplication
-- and subtraction function that perform overflow-checking.
instance Num SatInt where
  {-# INLINE (+) #-}
  + :: SatInt -> SatInt -> SatInt
(+) = SatInt -> SatInt -> SatInt
plusSI

  {-# INLINE (*) #-}
  * :: SatInt -> SatInt -> SatInt
(*) = SatInt -> SatInt -> SatInt
timesSI

  {-# INLINE (-) #-}
  (-) = SatInt -> SatInt -> SatInt
minusSI

  {-# INLINE negate #-}
  negate :: SatInt -> SatInt
negate (SI Int
y)
    | Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = SatInt
forall a. Bounded a => a
maxBound
    | Bool
otherwise     = Int -> SatInt
SI (Int -> Int
forall a. Num a => a -> a
negate Int
y)

  {-# INLINE abs #-}
  abs :: SatInt -> SatInt
abs SatInt
x
    | SatInt
x SatInt -> SatInt -> Bool
forall a. Ord a => a -> a -> Bool
>= SatInt
0    = SatInt
x
    | Bool
otherwise = SatInt -> SatInt
forall a. Num a => a -> a
negate SatInt
x

  {-# INLINE signum #-}
  signum :: SatInt -> SatInt
signum = (Int -> Int) -> SatInt -> SatInt
forall a b. Coercible a b => a -> b
coerce (Int -> Int
forall a. Num a => a -> a
signum :: Int -> Int)

  {-# INLINE fromInteger #-}
  fromInteger :: Integer -> SatInt
fromInteger Integer
x
    | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxBoundInteger  = SatInt
forall a. Bounded a => a
maxBound
    | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
minBoundInteger  = SatInt
forall a. Bounded a => a
minBound
    | Bool
otherwise            = Int -> SatInt
SI (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
x)

maxBoundInteger :: Integer
maxBoundInteger :: Integer
maxBoundInteger = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
maxInt
{-# INLINABLE maxBoundInteger #-}

minBoundInteger :: Integer
minBoundInteger :: Integer
minBoundInteger = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
minInt
{-# INLINABLE minBoundInteger #-}

{-
'addIntC#', 'subIntC#', and 'mulIntMayOflow#' have tricky returns:
all of them return non-zero (*not* necessarily 1) in the case of an overflow,
so we can't use 'isTrue#'; and the first two return a truncated value in
case of overflow, but this is *not* the same as the saturating result,
but rather a bitwise truncation that is typically not what we want.

So we have to case on the result, and then do some logic to work out what
kind of overflow we're facing, and pick the correct result accordingly.
-}

plusSI :: SatInt -> SatInt -> SatInt
plusSI :: SatInt -> SatInt -> SatInt
plusSI (SI (I# Int#
x#)) (SI (I# Int#
y#)) =
  case Int# -> Int# -> (# Int#, Int# #)
addIntC# Int#
x# Int#
y#  of
    (# Int#
r#, Int#
0# #) -> Int -> SatInt
SI (Int# -> Int
I# Int#
r#)
    -- Overflow
    (# Int#, Int# #)
_ ->
      if      Int# -> Bool
isTrue# ((Int#
x# Int# -> Int# -> Int#
># Int#
0#) Int# -> Int# -> Int#
`andI#` (Int#
y# Int# -> Int# -> Int#
># Int#
0#)) then SatInt
forall a. Bounded a => a
maxBound
      else if Int# -> Bool
isTrue# ((Int#
x# Int# -> Int# -> Int#
<# Int#
0#) Int# -> Int# -> Int#
`andI#` (Int#
y# Int# -> Int# -> Int#
<# Int#
0#)) then SatInt
forall a. Bounded a => a
minBound
      -- x and y have opposite signs, and yet we've overflowed, should
      -- be impossible
      else SatInt
forall a. a
overflowError
{-# INLINE plusSI #-}

minusSI :: SatInt -> SatInt -> SatInt
minusSI :: SatInt -> SatInt -> SatInt
minusSI (SI (I# Int#
x#)) (SI (I# Int#
y#)) =
  case Int# -> Int# -> (# Int#, Int# #)
subIntC# Int#
x# Int#
y# of
    (# Int#
r#, Int#
0# #) -> Int -> SatInt
SI (Int# -> Int
I# Int#
r#)
    -- Overflow
    (# Int#, Int# #)
_ ->
      if      Int# -> Bool
isTrue# ((Int#
x# Int# -> Int# -> Int#
>=# Int#
0#) Int# -> Int# -> Int#
`andI#` (Int#
y# Int# -> Int# -> Int#
<# Int#
0#)) then SatInt
forall a. Bounded a => a
maxBound
      else if Int# -> Bool
isTrue# ((Int#
x# Int# -> Int# -> Int#
<=# Int#
0#) Int# -> Int# -> Int#
`andI#` (Int#
y# Int# -> Int# -> Int#
># Int#
0#)) then SatInt
forall a. Bounded a => a
minBound
      -- x and y have the same sign, and yet we've overflowed, should
      -- be impossible
      else SatInt
forall a. a
overflowError
{-# INLINE minusSI #-}

timesSI :: SatInt -> SatInt -> SatInt
timesSI :: SatInt -> SatInt -> SatInt
timesSI (SI (I# Int#
x#)) (SI (I# Int#
y#)) =
  case Int# -> Int# -> Int#
mulIntMayOflo# Int#
x# Int#
y# of
      Int#
0# -> Int -> SatInt
SI (Int# -> Int
I# (Int#
x# Int# -> Int# -> Int#
*# Int#
y#))
      -- Overflow
      Int#
_ ->
          if      Int# -> Bool
isTrue# ((Int#
x# Int# -> Int# -> Int#
># Int#
0#) Int# -> Int# -> Int#
`andI#` (Int#
y# Int# -> Int# -> Int#
># Int#
0#)) then SatInt
forall a. Bounded a => a
maxBound
          else if Int# -> Bool
isTrue# ((Int#
x# Int# -> Int# -> Int#
># Int#
0#) Int# -> Int# -> Int#
`andI#` (Int#
y# Int# -> Int# -> Int#
<# Int#
0#)) then SatInt
forall a. Bounded a => a
minBound
          else if Int# -> Bool
isTrue# ((Int#
x# Int# -> Int# -> Int#
<# Int#
0#) Int# -> Int# -> Int#
`andI#` (Int#
y# Int# -> Int# -> Int#
># Int#
0#)) then SatInt
forall a. Bounded a => a
minBound
          else if Int# -> Bool
isTrue# ((Int#
x# Int# -> Int# -> Int#
<# Int#
0#) Int# -> Int# -> Int#
`andI#` (Int#
y# Int# -> Int# -> Int#
<# Int#
0#)) then SatInt
forall a. Bounded a => a
maxBound
          -- Logically unreachable unless x or y is 0, in which case
          -- it should be impossible to overflow
          else SatInt
forall a. a
overflowError
{-# INLINE timesSI #-}

-- Specialized versions of several functions. They're specialized for
-- Int in the GHC base libraries. We try to get the same effect by
-- including specialized code and adding a rewrite rule.

sumSI :: [SatInt] -> SatInt
sumSI :: [SatInt] -> SatInt
sumSI     [SatInt]
l       = [SatInt] -> SatInt -> SatInt
forall {a}. Num a => [a] -> a -> a
sum' [SatInt]
l SatInt
0
  where
    sum' :: [a] -> a -> a
sum' []     a
a = a
a
    sum' (a
x:[a]
xs) a
a = [a] -> a -> a
sum' [a]
xs (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
x

productSI :: [SatInt] -> SatInt
productSI :: [SatInt] -> SatInt
productSI [SatInt]
l       = [SatInt] -> SatInt -> SatInt
forall {a}. Num a => [a] -> a -> a
prod [SatInt]
l SatInt
1
  where
    prod :: [a] -> a -> a
prod []     a
a = a
a
    prod (a
x:[a]
xs) a
a = [a] -> a -> a
prod [a]
xs (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
x

{-# RULES
  "sum/SatInt"          sum = sumSI;
  "product/SatInt"      product = productSI
  #-}