Forked from
Glasgow Haskell Compiler / Packages / array
199 commits behind the upstream repository.
-
Ian Lynagh authored
Eliminate warnings in the libraries caused by mixing pattern matching with numeric literal matching.
Ian Lynagh authoredEliminate warnings in the libraries caused by mixing pattern matching with numeric literal matching.
Code owners
Assign users and groups as approvers for specific file changes. Learn more.
Num.lhs 17.56 KiB
\begin{code}
{-# OPTIONS_GHC -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Num
-- Copyright : (c) The University of Glasgow 1994-2002
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
-- The 'Num' class and the 'Integer' type.
--
-----------------------------------------------------------------------------
#include "MachDeps.h"
#if SIZEOF_HSWORD == 4
#define LEFTMOST_BIT 2147483648
#define DIGITS 9
#define BASE 1000000000
#elif SIZEOF_HSWORD == 8
#define LEFTMOST_BIT 9223372036854775808
#define DIGITS 18
#define BASE 1000000000000000000
#else
#error Please define LEFTMOST_BIT to be 2^(SIZEOF_HSWORD*8-1)
-- DIGITS should be the largest integer such that 10^DIGITS < LEFTMOST_BIT
-- BASE should be 10^DIGITS. Note that ^ is not available yet.
#endif
-- #hide
module GHC.Num where
import {-# SOURCE #-} GHC.Err
import GHC.Base
import GHC.Enum
import GHC.Show
infixl 7 *
infixl 6 +, -
default () -- Double isn't available yet,
-- and we shouldn't be using defaults anyway
\end{code}
%*********************************************************
%* *
\subsection{Standard numeric class}
%* *
%*********************************************************
\begin{code}
-- | Basic numeric class.
--
-- Minimal complete definition: all except 'negate' or @(-)@
class (Eq a, Show a) => Num a where
(+), (-), (*) :: a -> a -> a
-- | Unary negation.
negate :: a -> a
-- | Absolute value.
abs :: a -> a
-- | Sign of a number.
-- The functions 'abs' and 'signum' should satisfy the law:
--
-- > abs x * signum x == x
--
-- For real numbers, the 'signum' is either @-1@ (negative), @0@ (zero)
-- or @1@ (positive).
signum :: a -> a
-- | Conversion from an 'Integer'.
-- An integer literal represents the application of the function
-- 'fromInteger' to the appropriate value of type 'Integer',
-- so such literals have type @('Num' a) => a@.
fromInteger :: Integer -> a
x - y = x + negate y
negate x = 0 - x
-- | the same as @'flip' ('-')@.
--
-- Because @-@ is treated specially in the Haskell grammar,
-- @(-@ /e/@)@ is not a section, but an application of prefix negation.
-- However, @('subtract'@ /exp/@)@ is equivalent to the disallowed section.
{-# INLINE subtract #-}
subtract :: (Num a) => a -> a -> a
subtract x y = y - x
\end{code}
%*********************************************************
%* *
\subsection{Instances for @Int@}
%* *
%*********************************************************
\begin{code}
instance Num Int where
(+) = plusInt
(-) = minusInt
negate = negateInt
(*) = timesInt
abs n = if n `geInt` 0 then n else negateInt n
signum n | n `ltInt` 0 = negateInt 1
| n `eqInt` 0 = 0
| otherwise = 1
fromInteger = integer2Int
quotRemInt :: Int -> Int -> (Int, Int)
quotRemInt a@(I# _) b@(I# _) = (a `quotInt` b, a `remInt` b)
-- OK, so I made it a little stricter. Shoot me. (WDP 94/10)
divModInt :: Int -> Int -> (Int, Int)
divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y)
-- Stricter. Sorry if you don't like it. (WDP 94/10)
\end{code}
%*********************************************************
%* *
\subsection{The @Integer@ type}
%* *
%*********************************************************
\begin{code}
-- | Arbitrary-precision integers.
data Integer
= S# Int# -- small integers
#ifndef ILX
| J# Int# ByteArray# -- large integers
#else
| J# Void BigInteger -- .NET big ints
foreign type dotnet "BigInteger" BigInteger
#endif
\end{code}
Convenient boxed Integer PrimOps.
\begin{code}
zeroInteger :: Integer
zeroInteger = S# 0#
int2Integer :: Int -> Integer
{-# INLINE int2Integer #-}
int2Integer (I# i) = S# i
integer2Int :: Integer -> Int
integer2Int (S# i) = I# i
integer2Int (J# s d) = case (integer2Int# s d) of { n# -> I# n# }
toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d }
toBig i@(J# _ _) = i
\end{code}
%*********************************************************
%* *
\subsection{Dividing @Integers@}
%* *
%*********************************************************
\begin{code}
quotRemInteger :: Integer -> Integer -> (Integer, Integer)
quotRemInteger a@(S# (-LEFTMOST_BIT#)) b = quotRemInteger (toBig a) b
quotRemInteger (S# i) (S# j)
= case quotRemInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j )
quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2)
quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2
quotRemInteger (J# s1 d1) (J# s2 d2)
= case (quotRemInteger# s1 d1 s2 d2) of
(# s3, d3, s4, d4 #)
-> (J# s3 d3, J# s4 d4)
divModInteger a@(S# (-LEFTMOST_BIT#)) b = divModInteger (toBig a) b
divModInteger (S# i) (S# j)
= case divModInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2)
divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2
divModInteger (J# s1 d1) (J# s2 d2)
= case (divModInteger# s1 d1 s2 d2) of
(# s3, d3, s4, d4 #)
-> (J# s3 d3, J# s4 d4)
remInteger :: Integer -> Integer -> Integer
remInteger ia ib
| ib == 0 = error "Prelude.Integral.rem{Integer}: divide by 0"
remInteger a@(S# (-LEFTMOST_BIT#)) b = remInteger (toBig a) b
remInteger (S# a) (S# b) = S# (remInt# a b)
{- Special case doesn't work, because a 1-element J# has the range
-(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1)
remInteger ia@(S# a) (J# sb b)
| sb ==# 1# = S# (remInt# a (word2Int# (integer2Word# sb b)))
| sb ==# -1# = S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
| 0# <# sb = ia
| otherwise = S# (0# -# a)
-}
remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib
remInteger (J# sa a) (S# b)
= case int2Integer# b of { (# sb, b #) ->
case remInteger# sa a sb b of { (# sr, r #) ->
S# (integer2Int# sr r) }}
remInteger (J# sa a) (J# sb b)
= case remInteger# sa a sb b of (# sr, r #) -> J# sr r
quotInteger :: Integer -> Integer -> Integer
quotInteger ia ib
| ib == 0 = error "Prelude.Integral.quot{Integer}: divide by 0"
quotInteger a@(S# (-LEFTMOST_BIT#)) b = quotInteger (toBig a) b
quotInteger (S# a) (S# b) = S# (quotInt# a b)
{- Special case disabled, see remInteger above
quotInteger (S# a) (J# sb b)
| sb ==# 1# = S# (quotInt# a (word2Int# (integer2Word# sb b)))
| sb ==# -1# = S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
| otherwise = zeroInteger
-}
quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib
quotInteger (J# sa a) (S# b)
= case int2Integer# b of { (# sb, b #) ->
case quotInteger# sa a sb b of (# sq, q #) -> J# sq q }
quotInteger (J# sa a) (J# sb b)
= case quotInteger# sa a sb b of (# sg, g #) -> J# sg g
\end{code}
\begin{code}
gcdInteger :: Integer -> Integer -> Integer
-- SUP: Do we really need the first two cases?
gcdInteger a@(S# (-LEFTMOST_BIT#)) b = gcdInteger (toBig a) b
gcdInteger a b@(S# (-LEFTMOST_BIT#)) = gcdInteger a (toBig b)
gcdInteger (S# a) (S# b) = case gcdInt (I# a) (I# b) of { I# c -> S# c }
gcdInteger ia@(S# 0#) ib@(J# 0# _) = error "GHC.Num.gcdInteger: gcd 0 0 is undefined"
gcdInteger ia@(S# a) ib@(J# sb b)
| a ==# 0# = abs ib
| sb ==# 0# = abs ia
| otherwise = S# (gcdIntegerInt# absSb b absA)
where absA = if a <# 0# then negateInt# a else a
absSb = if sb <# 0# then negateInt# sb else sb
gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia
gcdInteger (J# 0# _) (J# 0# _) = error "GHC.Num.gcdInteger: gcd 0 0 is undefined"
gcdInteger (J# sa a) (J# sb b)
= case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g
lcmInteger :: Integer -> Integer -> Integer
lcmInteger a 0
= zeroInteger
lcmInteger 0 b
= zeroInteger
lcmInteger a b
= (divExact aa (gcdInteger aa ab)) * ab
where aa = abs a
ab = abs b
divExact :: Integer -> Integer -> Integer
divExact a@(S# (-LEFTMOST_BIT#)) b = divExact (toBig a) b
divExact (S# a) (S# b) = S# (quotInt# a b)
divExact (S# a) (J# sb b)
= S# (quotInt# a (integer2Int# sb b))
divExact (J# sa a) (S# b)
= case int2Integer# b of
(# sb, b #) -> case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
divExact (J# sa a) (J# sb b)
= case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
\end{code}
%*********************************************************
%* *
\subsection{The @Integer@ instances for @Eq@, @Ord@}
%* *
%*********************************************************
\begin{code}
instance Eq Integer where
(S# i) == (S# j) = i ==# j
(S# i) == (J# s d) = cmpIntegerInt# s d i ==# 0#
(J# s d) == (S# i) = cmpIntegerInt# s d i ==# 0#
(J# s1 d1) == (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#
(S# i) /= (S# j) = i /=# j
(S# i) /= (J# s d) = cmpIntegerInt# s d i /=# 0#
(J# s d) /= (S# i) = cmpIntegerInt# s d i /=# 0#
(J# s1 d1) /= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
------------------------------------------------------------------------
instance Ord Integer where
(S# i) <= (S# j) = i <=# j
(J# s d) <= (S# i) = cmpIntegerInt# s d i <=# 0#
(S# i) <= (J# s d) = cmpIntegerInt# s d i >=# 0#
(J# s1 d1) <= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
(S# i) > (S# j) = i ># j
(J# s d) > (S# i) = cmpIntegerInt# s d i ># 0#
(S# i) > (J# s d) = cmpIntegerInt# s d i <# 0#
(J# s1 d1) > (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
(S# i) < (S# j) = i <# j
(J# s d) < (S# i) = cmpIntegerInt# s d i <# 0#
(S# i) < (J# s d) = cmpIntegerInt# s d i ># 0#
(J# s1 d1) < (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
(S# i) >= (S# j) = i >=# j
(J# s d) >= (S# i) = cmpIntegerInt# s d i >=# 0#
(S# i) >= (J# s d) = cmpIntegerInt# s d i <=# 0#
(J# s1 d1) >= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
compare (S# i) (S# j)
| i ==# j = EQ
| i <=# j = LT
| otherwise = GT
compare (J# s d) (S# i)
= case cmpIntegerInt# s d i of { res# ->
if res# <# 0# then LT else
if res# ># 0# then GT else EQ
}
compare (S# i) (J# s d)
= case cmpIntegerInt# s d i of { res# ->
if res# ># 0# then LT else
if res# <# 0# then GT else EQ
}
compare (J# s1 d1) (J# s2 d2)
= case cmpInteger# s1 d1 s2 d2 of { res# ->
if res# <# 0# then LT else
if res# ># 0# then GT else EQ
}
\end{code}
%*********************************************************
%* *
\subsection{The @Integer@ instances for @Num@}
%* *
%*********************************************************
\begin{code}
instance Num Integer where
(+) = plusInteger
(-) = minusInteger
(*) = timesInteger
negate = negateInteger
fromInteger x = x
-- ORIG: abs n = if n >= 0 then n else -n
abs (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT
abs (S# i) = case abs (I# i) of I# j -> S# j
abs n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d
signum (S# i) = case signum (I# i) of I# j -> S# j
signum (J# s d)
= let
cmp = cmpIntegerInt# s d 0#
in
if cmp ># 0# then S# 1#
else if cmp ==# 0# then S# 0#
else S# (negateInt# 1#)
plusInteger i1@(S# i) i2@(S# j) = case addIntC# i j of { (# r, c #) ->
if c ==# 0# then S# r
else toBig i1 + toBig i2 }
plusInteger i1@(J# _ _) i2@(S# _) = i1 + toBig i2
plusInteger i1@(S# _) i2@(J# _ _) = toBig i1 + i2
plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
minusInteger i1@(S# i) i2@(S# j) = case subIntC# i j of { (# r, c #) ->
if c ==# 0# then S# r
else toBig i1 - toBig i2 }
minusInteger i1@(J# _ _) i2@(S# _) = i1 - toBig i2
minusInteger i1@(S# _) i2@(J# _ _) = toBig i1 - i2
minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
timesInteger i1@(S# i) i2@(S# j) = if mulIntMayOflo# i j ==# 0#
then S# (i *# j)
else toBig i1 * toBig i2
timesInteger i1@(J# _ _) i2@(S# _) = i1 * toBig i2
timesInteger i1@(S# _) i2@(J# _ _) = toBig i1 * i2
timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
negateInteger (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT
negateInteger (S# i) = S# (negateInt# i)
negateInteger (J# s d) = J# (negateInt# s) d
\end{code}
%*********************************************************
%* *
\subsection{The @Integer@ instance for @Enum@}
%* *
%*********************************************************
\begin{code}
instance Enum Integer where
succ x = x + 1
pred x = x - 1
toEnum n = int2Integer n
fromEnum n = integer2Int n
{-# INLINE enumFrom #-}
{-# INLINE enumFromThen #-}
{-# INLINE enumFromTo #-}
{-# INLINE enumFromThenTo #-}
enumFrom x = enumDeltaInteger x 1
enumFromThen x y = enumDeltaInteger x (y-x)
enumFromTo x lim = enumDeltaToInteger x 1 lim
enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim
{-# RULES
"enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y)
"efdtInteger" [~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l)
"enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger
"enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger
#-}
enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d
enumDeltaInteger :: Integer -> Integer -> [Integer]
enumDeltaInteger x d = x : enumDeltaInteger (x+d) d
enumDeltaToIntegerFB c n x delta lim
| delta >= 0 = up_fb c n x delta lim
| otherwise = dn_fb c n x delta lim
enumDeltaToInteger x delta lim
| delta >= 0 = up_list x delta lim
| otherwise = dn_list x delta lim
up_fb c n x delta lim = go (x::Integer)
where
go x | x > lim = n
| otherwise = x `c` go (x+delta)
dn_fb c n x delta lim = go (x::Integer)
where
go x | x < lim = n
| otherwise = x `c` go (x+delta)
up_list x delta lim = go (x::Integer)
where
go x | x > lim = []
| otherwise = x : go (x+delta)
dn_list x delta lim = go (x::Integer)
where
go x | x < lim = []
| otherwise = x : go (x+delta)
\end{code}
%*********************************************************
%* *
\subsection{The @Integer@ instances for @Show@}
%* *
%*********************************************************
\begin{code}
instance Show Integer where
showsPrec p n r
| p > 6 && n < 0 = '(' : jtos n (')' : r)
-- Minor point: testing p first gives better code
-- in the not-uncommon case where the p argument
-- is a constant
| otherwise = jtos n r
showList = showList__ (showsPrec 0)
-- Divide an conquer implementation of string conversion
jtos :: Integer -> String -> String
jtos n cs
| n < 0 = '-' : jtos' (-n) cs
| otherwise = jtos' n cs
where
jtos' :: Integer -> String -> String
jtos' n cs
| n < BASE = jhead (fromInteger n) cs
| otherwise = jprinth (jsplitf (BASE*BASE) n) cs
-- Split n into digits in base p. We first split n into digits
-- in base p*p and then split each of these digits into two.
-- Note that the first 'digit' modulo p*p may have a leading zero
-- in base p that we need to drop - this is what jsplith takes care of.
-- jsplitb the handles the remaining digits.
jsplitf :: Integer -> Integer -> [Integer]
jsplitf p n
| p > n = [n]
| otherwise = jsplith p (jsplitf (p*p) n)
jsplith :: Integer -> [Integer] -> [Integer]
jsplith p (n:ns) =
if q > 0 then fromInteger q : fromInteger r : jsplitb p ns
else fromInteger r : jsplitb p ns
where
(q, r) = n `quotRemInteger` p
jsplitb :: Integer -> [Integer] -> [Integer]
jsplitb p [] = []
jsplitb p (n:ns) = q : r : jsplitb p ns
where
(q, r) = n `quotRemInteger` p
-- Convert a number that has been split into digits in base BASE^2
-- this includes a last splitting step and then conversion of digits
-- that all fit into a machine word.
jprinth :: [Integer] -> String -> String
jprinth (n:ns) cs =
if q > 0 then jhead q $ jblock r $ jprintb ns cs
else jhead r $ jprintb ns cs
where
(q', r') = n `quotRemInteger` BASE
q = fromInteger q'
r = fromInteger r'
jprintb :: [Integer] -> String -> String
jprintb [] cs = cs
jprintb (n:ns) cs = jblock q $ jblock r $ jprintb ns cs
where
(q', r') = n `quotRemInteger` BASE
q = fromInteger q'
r = fromInteger r'
-- Convert an integer that fits into a machine word. Again, we have two
-- functions, one that drops leading zeros (jhead) and one that doesn't
-- (jblock)
jhead :: Int -> String -> String
jhead n cs
| n < 10 = case unsafeChr (ord '0' + n) of
c@(C# _) -> c : cs
| otherwise = case unsafeChr (ord '0' + r) of
c@(C# _) -> jhead q (c : cs)
where
(q, r) = n `quotRemInt` 10
jblock = jblock' {- ' -} DIGITS
jblock' :: Int -> Int -> String -> String
jblock' d n cs
| d == 1 = case unsafeChr (ord '0' + n) of
c@(C# _) -> c : cs
| otherwise = case unsafeChr (ord '0' + r) of
c@(C# _) -> jblock' (d - 1) q (c : cs)
where
(q, r) = n `quotRemInt` 10
\end{code}