module Data.SafeInt (SafeInt(..), fromSafe, toSafe) where
import GHC.Prim
import GHC.Base
import GHC.Err
import GHC.Num
import GHC.Word
import GHC.Real
import GHC.Types
newtype SafeInt = SI Int
fromSafe :: SafeInt -> Int
fromSafe (SI x) = x
toSafe :: Int -> SafeInt
toSafe x = SI x
instance Show SafeInt where
showsPrec p x = showsPrec p (fromSafe x)
instance Read SafeInt where
readsPrec p xs = [ (toSafe x, r) | (x, r) <- readsPrec p xs ]
instance Eq SafeInt where
SI x == SI y = eqInt x y
SI x /= SI y = neInt x y
instance Ord SafeInt where
SI x < SI y = ltInt x y
SI x <= SI y = leInt x y
SI x > SI y = gtInt x y
SI x >= SI y = geInt x y
instance Num SafeInt where
(+) = plusSI
(*) = timesSI
() = minusSI
negate (SI y)
| y == minInt = overflowError
| otherwise = SI (negate y)
abs x
| x >= 0 = x
| otherwise = negate x
signum x | x > 0 = 1
signum 0 = 0
signum _ = 1
fromInteger x
| x > maxBoundInteger || x < minBoundInteger
= overflowError
| otherwise = SI (fromInteger x)
maxBoundInteger :: Integer
maxBoundInteger = toInteger maxInt
minBoundInteger :: Integer
minBoundInteger = toInteger minInt
instance Bounded SafeInt where
minBound = SI minInt
maxBound = SI maxInt
instance Enum SafeInt where
succ (SI x) = SI (succ x)
pred (SI x) = SI (pred x)
toEnum = SI
fromEnum = fromSafe
enumFrom (SI (I# x)) = eftInt x maxInt#
where !(I# maxInt#) = maxInt
enumFromTo (SI (I# x)) (SI (I# y)) = eftInt x y
enumFromThen (SI (I# x1)) (SI (I# x2)) = efdInt x1 x2
enumFromThenTo (SI (I# x1)) (SI (I# x2)) (SI (I# y)) = efdtInt x1 x2 y
eftInt :: Int# -> Int# -> [SafeInt]
eftInt x0 y | x0 ># y = []
| otherwise = go x0
where
go x = SI (I# x) : if x ==# y then [] else go (x +# 1#)
eftIntFB :: (SafeInt -> r -> r) -> r -> Int# -> Int# -> r
eftIntFB c n x0 y | x0 ># y = n
| otherwise = go x0
where
go x = SI (I# x) `c` if x ==# y then n else go (x +# 1#)
efdInt :: Int# -> Int# -> [SafeInt]
efdInt x1 x2
| x2 >=# x1 = case maxInt of I# y -> efdtIntUp x1 x2 y
| otherwise = case minInt of I# y -> efdtIntDn x1 x2 y
efdtInt :: Int# -> Int# -> Int# -> [SafeInt]
efdtInt x1 x2 y
| x2 >=# x1 = efdtIntUp x1 x2 y
| otherwise = efdtIntDn x1 x2 y
efdtIntFB :: (SafeInt -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntFB c n x1 x2 y
| x2 >=# x1 = efdtIntUpFB c n x1 x2 y
| otherwise = efdtIntDnFB c n x1 x2 y
efdtIntUp :: Int# -> Int# -> Int# -> [SafeInt]
efdtIntUp x1 x2 y
| y <# x2 = if y <# x1 then [] else [SI (I# x1)]
| otherwise =
let !delta = x2 -# x1
!y' = y -# delta
go_up x | x ># y' = [SI (I# x)]
| otherwise = SI (I# x) : go_up (x +# delta)
in SI (I# x1) : go_up x2
efdtIntUpFB :: (SafeInt -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntUpFB c n x1 x2 y
| y <# x2 = if y <# x1 then n else SI (I# x1) `c` n
| otherwise =
let !delta = x2 -# x1
!y' = y -# delta
go_up x | x ># y' = SI (I# x) `c` n
| otherwise = SI (I# x) `c` go_up (x +# delta)
in SI (I# x1) `c` go_up x2
efdtIntDn :: Int# -> Int# -> Int# -> [SafeInt]
efdtIntDn x1 x2 y
| y ># x2 = if y ># x1 then [] else [SI (I# x1)]
| otherwise =
let !delta = x2 -# x1
!y' = y -# delta
go_dn x | x <# y' = [SI (I# x)]
| otherwise = SI (I# x) : go_dn (x +# delta)
in SI (I# x1) : go_dn x2
efdtIntDnFB :: (SafeInt -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntDnFB c n x1 x2 y
| y ># x2 = if y ># x1 then n else SI (I# x1) `c` n
| otherwise =
let !delta = x2 -# x1
!y' = y -# delta
go_dn x | x <# y' = SI (I# x) `c` n
| otherwise = SI (I# x) `c` go_dn (x +# delta)
in SI (I# x1) `c` go_dn x2
instance Real SafeInt where
toRational (SI x) = toInteger x % 1
instance Integral SafeInt where
toInteger (SI (I# i)) = smallInteger i
SI a `quot` SI b
| b == 0 = divZeroError
| a == minBound && b == (1) = overflowError
| otherwise = SI (a `quotInt` b)
SI a `rem` SI b
| b == 0 = divZeroError
| a == minBound && b == (1) = overflowError
| otherwise = SI (a `remInt` b)
SI a `div` SI b
| b == 0 = divZeroError
| a == minBound && b == (1) = overflowError
| otherwise = SI (a `divInt` b)
SI a `mod` SI b
| b == 0 = divZeroError
| a == minBound && b == (1) = overflowError
| otherwise = SI (a `modInt` b)
SI a `quotRem` SI b
| b == 0 = divZeroError
| a == minBound && b == (1) = overflowError
| otherwise = a `quotRemSafeInt` b
SI a `divMod` SI b
| b == 0 = divZeroError
| a == minBound && b == (1) = overflowError
| otherwise = a `divModSafeInt` b
quotRemSafeInt :: Int -> Int -> (SafeInt, SafeInt)
quotRemSafeInt a@(I# _) b@(I# _) = (SI (a `quotInt` b), SI (a `remInt` b))
divModSafeInt :: Int -> Int -> (SafeInt, SafeInt)
divModSafeInt x@(I# _) y@(I# _) = (SI (x `divInt` y), SI (x `modInt` y))
plusSI :: SafeInt -> SafeInt -> SafeInt
plusSI (SI (I# x#)) (SI (I# y#)) =
case addIntC# x# y# of
(# r#, 0# #) -> SI (I# r#)
(# _ , _ #) -> overflowError
minusSI :: SafeInt -> SafeInt -> SafeInt
minusSI (SI (I# x#)) (SI (I# y#)) =
case subIntC# x# y# of
(# r#, 0# #) -> SI (I# r#)
(# _ , _ #) -> overflowError
timesSI :: SafeInt -> SafeInt -> SafeInt
timesSI (SI (I# x#)) (SI (I# y#)) =
case mulIntMayOflo# x# y# of
0# -> SI (I# (x# *# y#))
_ -> overflowError
sumS :: [SafeInt] -> SafeInt
sumS l = sum' l 0
where
sum' [] a = a
sum' (x:xs) a = sum' xs (a + x)
productS :: [SafeInt] -> SafeInt
productS l = prod l 1
where
prod [] a = a
prod (x:xs) a = prod xs (a*x)
lcmS :: SafeInt -> SafeInt -> SafeInt
lcmS _ (SI 0) = SI 0
lcmS (SI 0) _ = SI 0
lcmS (SI x) (SI y) = abs (SI (x `quot` (gcd x y)) * SI y)