From 72e4fe7801d2d8ab5b243cbb430272b45010f59d Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 23 Mar 2008 18:13:42 +0000 Subject: [PATCH] Move Integer out into its own package We now depend on the new integer package. We also depend on a new ghc-prim package, which has GHC.Prim, GHC.PrimopWrappers, and new modules GHC.Bool and GHC.Generics, containing Bool and Unit/Inl/Inr respectively. --- Data/Bits.hs | 31 +--- Data/Unique.hs | 8 +- GHC/Base.lhs | 39 +++--- GHC/Exts.hs | 3 +- GHC/Float.lhs | 31 ++-- GHC/Int.hs | 24 ++-- GHC/Num.lhs | 429 ++++++++++++++------------------------------------------ GHC/Ptr.lhs | 5 +- GHC/Real.lhs | 17 ++- GHC/Word.hs | 33 ++--- base.cabal | 5 +- 11 files changed, 184 insertions(+), 441 deletions(-) diff --git a/Data/Bits.hs b/Data/Bits.hs index a1a6e8b..8f6776f 100644 --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -259,30 +259,11 @@ foreign import ccall nhc_primIntCompl :: Int -> Int #endif /* __NHC__ */ instance Bits Integer where -#ifdef __GLASGOW_HASKELL__ - (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y)) - x@(S# _) .&. y = toBig x .&. y - x .&. y@(S# _) = x .&. toBig y - (J# s1 d1) .&. (J# s2 d2) = - case andInteger# s1 d1 s2 d2 of - (# s, d #) -> J# s d - - (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y)) - x@(S# _) .|. y = toBig x .|. y - x .|. y@(S# _) = x .|. toBig y - (J# s1 d1) .|. (J# s2 d2) = - case orInteger# s1 d1 s2 d2 of - (# s, d #) -> J# s d - - (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y)) - x@(S# _) `xor` y = toBig x `xor` y - x `xor` y@(S# _) = x `xor` toBig y - (J# s1 d1) `xor` (J# s2 d2) = - case xorInteger# s1 d1 s2 d2 of - (# s, d #) -> J# s d - - complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#))) - complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d +#if defined(__GLASGOW_HASKELL__) + (.&.) = andInteger + (.|.) = orInteger + xor = xorInteger + complement = complementInteger #else -- reduce bitwise binary operations to special cases we can handle @@ -309,7 +290,7 @@ instance Bits Integer where bitSize _ = error "Data.Bits.bitSize(Integer)" isSigned _ = True -#ifndef __GLASGOW_HASKELL__ +#if !defined(__GLASGOW_HASKELL__) -- Crude implementation of bitwise operations on Integers: convert them -- to finite lists of Ints (least significant first), zip and convert -- back again. diff --git a/Data/Unique.hs b/Data/Unique.hs index 502739f..6f8c24f 100644 --- a/Data/Unique.hs +++ b/Data/Unique.hs @@ -26,7 +26,7 @@ import System.IO.Unsafe (unsafePerformIO) #ifdef __GLASGOW_HASKELL__ import GHC.Base -import GHC.Num ( Integer(..) ) +import GHC.Num #endif -- | An abstract unique object. Objects of type 'Unique' may be @@ -52,10 +52,8 @@ newUnique = do -- same value, although in practice this is unlikely. The 'Int' -- returned makes a good hash key. hashUnique :: Unique -> Int -#ifdef __GLASGOW_HASKELL__ -hashUnique (Unique (S# i)) = I# i -hashUnique (Unique (J# s d)) | s ==# 0# = 0 - | otherwise = I# (indexIntArray# d 0#) +#if defined(__GLASGOW_HASKELL__) +hashUnique (Unique i) = I# (hashInteger i) #else hashUnique (Unique u) = fromInteger (u `mod` (toInteger (maxBound :: Int) + 1)) #endif diff --git a/GHC/Base.lhs b/GHC/Base.lhs index d6d7179..751a908 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -84,11 +84,15 @@ Other Prelude modules are much easier with fewer complex dependencies. module GHC.Base ( module GHC.Base, + module GHC.Bool, + module GHC.Generics, module GHC.Prim, -- Re-export GHC.Prim and GHC.Err, to avoid lots module GHC.Err -- of people having to import it explicitly ) where +import GHC.Bool +import GHC.Generics import GHC.Prim import {-# SOURCE #-} GHC.Err @@ -468,8 +472,25 @@ mapFB c f x ys = c (f x) ys -- first so that the corresponding 'Prelude.Enum' instance will give -- 'Prelude.fromEnum' 'False' the value zero, and -- 'Prelude.fromEnum' 'True' the value 1. -data Bool = False | True deriving (Eq, Ord) - -- Read in GHC.Read, Show in GHC.Show +-- The actual definition is in the ghc-prim package. + +-- XXX These don't work: +-- deriving instance Eq Bool +-- deriving instance Ord Bool +-- : +-- Illegal binding of built-in syntax: con2tag_Bool# + +instance Eq Bool where + True == True = True + False == False = True + _ == _ = False + +instance Ord Bool where + compare False True = LT + compare True False = GT + compare _ _ = EQ + +-- Read is in GHC.Read, Show in GHC.Show -- Boolean functions @@ -773,20 +794,6 @@ asTypeOf = const %********************************************************* %* * -\subsection{Generics} -%* * -%********************************************************* - -\begin{code} -data Unit = Unit -#ifndef __HADDOCK__ -data (:+:) a b = Inl a | Inr b -data (:*:) a b = a :*: b -#endif -\end{code} - -%********************************************************* -%* * \subsection{@getTag@} %* * %********************************************************* diff --git a/GHC/Exts.hs b/GHC/Exts.hs index 2baf420..5c3c495 100644 --- a/GHC/Exts.hs +++ b/GHC/Exts.hs @@ -15,7 +15,8 @@ module GHC.Exts ( -- * Representations of some basic types - Int(..),Word(..),Float(..),Double(..),Integer(..),Char(..), + Int(..),Word(..),Float(..),Double(..), + Char(..), Ptr(..), FunPtr(..), -- * Primitive operations diff --git a/GHC/Float.lhs b/GHC/Float.lhs index 6808d63..d0b7a33 100644 --- a/GHC/Float.lhs +++ b/GHC/Float.lhs @@ -190,13 +190,7 @@ instance Num Float where | otherwise = negate 1 {-# INLINE fromInteger #-} - fromInteger (S# i#) = case (int2Float# i#) of { d# -> F# d# } - fromInteger (J# s# d#) = encodeFloat# s# d# 0 - -- previous code: fromInteger n = encodeFloat n 0 - -- doesn't work too well, because encodeFloat is defined in - -- terms of ccalls which can never be simplified away. We - -- want simple literals like (fromInteger 3 :: Float) to turn - -- into (F# 3.0), hence the special case for S# here. + fromInteger i = F# (floatFromInteger i) instance Real Float where toRational x = (m%1)*(b%1)^^n @@ -278,12 +272,10 @@ instance RealFloat Float where floatDigits _ = FLT_MANT_DIG -- ditto floatRange _ = (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto - decodeFloat (F# f#) - = case decodeFloat# f# of - (# exp#, s#, d# #) -> (J# s# d#, I# exp#) + decodeFloat (F# f#) = case decodeFloatInteger f# of + (# i, e #) -> (i, I# e) - encodeFloat (S# i) j = int_encodeFloat# i j - encodeFloat (J# s# d#) e = encodeFloat# s# d# e + encodeFloat i (I# e) = F# (encodeFloatInteger i e) exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x @@ -336,9 +328,7 @@ instance Num Double where | otherwise = negate 1 {-# INLINE fromInteger #-} - -- See comments with Num Float - fromInteger (S# i#) = case (int2Double# i#) of { d# -> D# d# } - fromInteger (J# s# d#) = encodeDouble# s# d# 0 + fromInteger i = D# (doubleFromInteger i) instance Real Double where @@ -422,11 +412,10 @@ instance RealFloat Double where floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto decodeFloat (D# x#) - = case decodeDouble# x# of - (# exp#, s#, d# #) -> (J# s# d#, I# exp#) + = case decodeDoubleInteger x# of + (# i, j #) -> (i, I# j) - encodeFloat (S# i) j = int_encodeDouble# i j - encodeFloat (J# s# d#) e = encodeDouble# s# d# e + encodeFloat i (I# j) = D# (encodeDoubleInteger i j) exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x @@ -645,7 +634,7 @@ floatToDigits base x = (p - 1 + e0) * 3 `div` 10 else ceiling ((log (fromInteger (f+1)) + - fromInteger (int2Integer e) * log (fromInteger b)) / + fromIntegral e * log (fromInteger b)) / log (fromInteger base)) --WAS: fromInt e * log (fromInteger b)) @@ -936,8 +925,6 @@ foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float - foreign import ccall unsafe "__encodeDouble" encodeDouble# :: Int# -> ByteArray# -> Int -> Double -foreign import ccall unsafe "__int_encodeDouble" - int_encodeDouble# :: Int# -> Int -> Double foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int diff --git a/GHC/Int.hs b/GHC/Int.hs index e37d2bb..9e19f9f 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -56,8 +56,7 @@ instance Num Int8 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger (S# i#) = I8# (narrow8Int# i#) - fromInteger (J# s# d#) = I8# (narrow8Int# (integer2Int# s# d#)) + fromInteger i = I8# (narrow8Int# (toInt# i)) instance Real Int8 where toRational x = toInteger x % 1 @@ -104,7 +103,7 @@ instance Integral Int8 where | x == minBound && y == (-1) = overflowError | otherwise = (I8# (narrow8Int# (x# `divInt#` y#)), I8# (narrow8Int# (x# `modInt#` y#))) - toInteger (I8# x#) = S# x# + toInteger (I8# x#) = smallInteger x# instance Bounded Int8 where minBound = -0x80 @@ -169,8 +168,7 @@ instance Num Int16 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger (S# i#) = I16# (narrow16Int# i#) - fromInteger (J# s# d#) = I16# (narrow16Int# (integer2Int# s# d#)) + fromInteger i = I16# (narrow16Int# (toInt# i)) instance Real Int16 where toRational x = toInteger x % 1 @@ -217,7 +215,7 @@ instance Integral Int16 where | x == minBound && y == (-1) = overflowError | otherwise = (I16# (narrow16Int# (x# `divInt#` y#)), I16# (narrow16Int# (x# `modInt#` y#))) - toInteger (I16# x#) = S# x# + toInteger (I16# x#) = smallInteger x# instance Bounded Int16 where minBound = -0x8000 @@ -342,7 +340,7 @@ instance Integral Int32 where I32# (x# `modInt32#` y#)) toInteger x@(I32# x#) | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) - = S# (int32ToInt# x#) + = smallInteger (int32ToInt# x#) | otherwise = case int32ToInteger# x# of (# s, d #) -> J# s d divInt32#, modInt32# :: Int32# -> Int32# -> Int32# @@ -445,8 +443,7 @@ instance Num Int32 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger (S# i#) = I32# (narrow32Int# i#) - fromInteger (J# s# d#) = I32# (narrow32Int# (integer2Int# s# d#)) + fromInteger i = I32# (narrow32Int# (toInt# i)) instance Enum Int32 where succ x @@ -494,7 +491,7 @@ instance Integral Int32 where | x == minBound && y == (-1) = overflowError | otherwise = (I32# (narrow32Int# (x# `divInt#` y#)), I32# (narrow32Int# (x# `modInt#` y#))) - toInteger (I32# x#) = S# x# + toInteger (I32# x#) = smallInteger x# instance Read Int32 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] @@ -627,7 +624,7 @@ instance Integral Int64 where toInteger x@(I64# x#) | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) - = S# (int64ToInt# x#) + = smallInteger (int64ToInt# x#) | otherwise = case int64ToInteger# x# of (# s, d #) -> J# s d @@ -749,8 +746,7 @@ instance Num Int64 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger (S# i#) = I64# i# - fromInteger (J# s# d#) = I64# (integer2Int# s# d#) + fromInteger i = I64# (toInt# i) instance Enum Int64 where succ x @@ -789,7 +785,7 @@ instance Integral Int64 where | y == 0 = divZeroError | x == minBound && y == (-1) = overflowError | otherwise = (I64# (x# `divInt#` y#), I64# (x# `modInt#` y#)) - toInteger (I64# x#) = S# x# + toInteger (I64# x#) = smallInteger x# instance Read Int64 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] diff --git a/GHC/Num.lhs b/GHC/Num.lhs index 40052f9..5f3f865 100644 --- a/GHC/Num.lhs +++ b/GHC/Num.lhs @@ -17,25 +17,25 @@ #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 +#error Please define DIGITS and BASE +-- DIGITS should be the largest integer such that +-- 10^DIGITS < 2^(SIZEOF_HSWORD * 8 - 1) -- BASE should be 10^DIGITS. Note that ^ is not available yet. #endif -- #hide -module GHC.Num where +module GHC.Num (module GHC.Num, module GHC.Integer) where import GHC.Base import GHC.Enum import GHC.Show +import GHC.Integer infixl 7 * infixl 6 +, - @@ -106,7 +106,7 @@ instance Num Int where | n `eqInt` 0 = 0 | otherwise = 1 - fromInteger = integer2Int + fromInteger i = I# (toInt# i) quotRemInt :: Int -> Int -> (Int, Int) quotRemInt a@(I# _) b@(I# _) = (a `quotInt` b, a `remInt` b) @@ -119,212 +119,122 @@ divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y) %********************************************************* %* * -\subsection{The @Integer@ type} +\subsection{The @Integer@ instances for @Eq@, @Ord@} %* * %********************************************************* \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# } +instance Eq Integer where + (==) = eqInteger + (/=) = neqInteger -toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d } -toBig i@(J# _ _) = i +------------------------------------------------------------------------ +instance Ord Integer where + (<=) = leInteger + (>) = gtInteger + (<) = ltInteger + (>=) = geInteger + + i `compare` j = case i `compareInteger` j of + -1# -> LT + 0# -> EQ + 1# -> GT + _ -> error "compareInteger: Bad result" \end{code} %********************************************************* %* * -\subsection{Dividing @Integers@} +\subsection{The @Integer@ instances for @Show@} %* * %********************************************************* \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} +instance Show Integer where + showsPrec p n r + | p > 6 && n < 0 = '(' : integerToString n (')' : r) + -- Minor point: testing p first gives better code + -- in the not-uncommon case where the p argument + -- is a constant + | otherwise = integerToString n r + showList = showList__ (showsPrec 0) +-- Divide an conquer implementation of string conversion +integerToString :: Integer -> String -> String +integerToString n cs + | n < 0 = '-' : integerToString' (-n) cs + | otherwise = integerToString' n cs + where + integerToString' :: Integer -> String -> String + integerToString' 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) -\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} + jsplith :: Integer -> [Integer] -> [Integer] + jsplith p (n:ns) = + case n `quotRemInteger` p of + (# q, r #) -> + if q > 0 then fromInteger q : fromInteger r : jsplitb p ns + else fromInteger r : jsplitb p ns + jsplitb :: Integer -> [Integer] -> [Integer] + jsplitb p [] = [] + jsplitb p (n:ns) = case n `quotRemInteger` p of + (# q, r #) -> + q : r : jsplitb p ns -%********************************************************* -%* * -\subsection{The @Integer@ instances for @Eq@, @Ord@} -%* * -%********************************************************* + -- 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 = + case n `quotRemInteger` BASE of + (# q', r' #) -> + let q = fromInteger q' + r = fromInteger r' + in if q > 0 then jhead q $ jblock r $ jprintb ns cs + else jhead r $ jprintb ns cs -\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# + jprintb :: [Integer] -> String -> String + jprintb [] cs = cs + jprintb (n:ns) cs = case n `quotRemInteger` BASE of + (# q', r' #) -> + let q = fromInteger q' + r = fromInteger r' + in jblock q $ jblock r $ jprintb ns cs - (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# + -- 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 ------------------------------------------------------------------------- -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 - } + 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} @@ -342,44 +252,8 @@ instance Num Integer where 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 + abs = absInteger + signum = signumInteger \end{code} @@ -393,8 +267,8 @@ negateInteger (J# s d) = J# (negateInt# s) d instance Enum Integer where succ x = x + 1 pred x = x - 1 - toEnum n = int2Integer n - fromEnum n = integer2Int n + toEnum (I# n) = smallInteger n + fromEnum n = I# (toInt# n) {-# INLINE enumFrom #-} {-# INLINE enumFromThen #-} @@ -446,98 +320,3 @@ dn_list x delta lim = go (x::Integer) \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} diff --git a/GHC/Ptr.lhs b/GHC/Ptr.lhs index 0b5679f..5e1b982 100644 --- a/GHC/Ptr.lhs +++ b/GHC/Ptr.lhs @@ -149,14 +149,11 @@ castPtrToFunPtr (Ptr addr) = FunPtr addr #if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64) instance Show (Ptr a) where - showsPrec p (Ptr a) rs = pad_out (showHex (word2Integer(int2Word#(addr2Int# a))) "") rs + showsPrec p (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) "") rs where -- want 0s prefixed to pad it out to a fixed length. pad_out ls rs = '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs - -- word2Integer :: Word# -> Integer (stolen from Word.lhs) - word2Integer w = case word2Integer# w of - (# s, d #) -> J# s d instance Show (FunPtr a) where showsPrec p = showsPrec p . castFunPtrToPtr diff --git a/GHC/Real.lhs b/GHC/Real.lhs index 2994f1e..9b61445 100644 --- a/GHC/Real.lhs +++ b/GHC/Real.lhs @@ -229,7 +229,7 @@ instance Real Int where toRational x = toInteger x % 1 instance Integral Int where - toInteger i = int2Integer i -- give back a full-blown Integer + toInteger (I# i) = smallInteger i a `quot` b | b == 0 = divZeroError @@ -283,10 +283,12 @@ instance Integral Integer where n `rem` d = n `remInteger` d a `divMod` 0 = divZeroError - a `divMod` b = a `divModInteger` b + a `divMod` b = case a `divModInteger` b of + (# x, y #) -> (x, y) a `quotRem` 0 = divZeroError - a `quotRem` b = a `quotRemInteger` b + a `quotRem` b = case a `quotRemInteger` b of + (# q, r #) -> (q, r) -- use the defaults for div & mod \end{code} @@ -342,7 +344,7 @@ instance (Integral a) => Enum (Ratio a) where succ x = x + 1 pred x = x - 1 - toEnum n = fromInteger (int2Integer n) :% 1 + toEnum n = fromIntegral n :% 1 fromEnum = fromInteger . truncate enumFrom = numericEnumFrom @@ -436,13 +438,16 @@ lcm _ 0 = 0 lcm 0 _ = 0 lcm x y = abs ((x `quot` (gcd x y)) * y) - {-# RULES "gcd/Int->Int->Int" gcd = gcdInt -"gcd/Integer->Integer->Integer" gcd = gcdInteger +"gcd/Integer->Integer->Integer" gcd = gcdInteger' "lcm/Integer->Integer->Integer" lcm = lcmInteger #-} +gcdInteger' :: Integer -> Integer -> Integer +gcdInteger' 0 0 = error "GHC.Real.gcdInteger': gcd 0 0 is undefined" +gcdInteger' a b = gcdInteger a b + integralEnumFrom :: (Integral a, Bounded a) => a -> [a] integralEnumFrom n = map fromInteger [toInteger n .. toInteger (maxBound `asTypeOf` n)] diff --git a/GHC/Word.hs b/GHC/Word.hs index dbb1bb3..2e33310 100644 --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -83,8 +83,7 @@ instance Num Word where abs x = x signum 0 = 0 signum _ = 1 - fromInteger (S# i#) = W# (int2Word# i#) - fromInteger (J# s# d#) = W# (integer2Word# s# d#) + fromInteger i = W# (integerToWord i) instance Real Word where toRational x = toInteger x % 1 @@ -128,8 +127,8 @@ instance Integral Word where | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) | otherwise = divZeroError toInteger (W# x#) - | i# >=# 0# = S# i# - | otherwise = case word2Integer# x# of (# s, d #) -> J# s d + | i# >=# 0# = smallInteger i# + | otherwise = wordToInteger x# where i# = word2Int# x# @@ -200,8 +199,7 @@ instance Num Word8 where abs x = x signum 0 = 0 signum _ = 1 - fromInteger (S# i#) = W8# (narrow8Word# (int2Word# i#)) - fromInteger (J# s# d#) = W8# (narrow8Word# (integer2Word# s# d#)) + fromInteger i = W8# (narrow8Word# (integerToWord i)) instance Real Word8 where toRational x = toInteger x % 1 @@ -240,7 +238,7 @@ instance Integral Word8 where divMod x@(W8# x#) y@(W8# y#) | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W8# x#) = S# (word2Int# x#) + toInteger (W8# x#) = smallInteger (word2Int# x#) instance Bounded Word8 where minBound = 0 @@ -301,8 +299,7 @@ instance Num Word16 where abs x = x signum 0 = 0 signum _ = 1 - fromInteger (S# i#) = W16# (narrow16Word# (int2Word# i#)) - fromInteger (J# s# d#) = W16# (narrow16Word# (integer2Word# s# d#)) + fromInteger i = W16# (narrow16Word# (integerToWord i)) instance Real Word16 where toRational x = toInteger x % 1 @@ -341,7 +338,7 @@ instance Integral Word16 where divMod x@(W16# x#) y@(W16# y#) | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W16# x#) = S# (word2Int# x#) + toInteger (W16# x#) = smallInteger (word2Int# x#) instance Bounded Word16 where minBound = 0 @@ -524,8 +521,7 @@ instance Num Word32 where abs x = x signum 0 = 0 signum _ = 1 - fromInteger (S# i#) = W32# (narrow32Word# (int2Word# i#)) - fromInteger (J# s# d#) = W32# (narrow32Word# (integer2Word# s# d#)) + fromInteger i = W32# (narrow32Word# (integerToWord i)) instance Enum Word32 where succ x @@ -577,12 +573,12 @@ instance Integral Word32 where | otherwise = divZeroError toInteger (W32# x#) #if WORD_SIZE_IN_BITS == 32 - | i# >=# 0# = S# i# - | otherwise = case word2Integer# x# of (# s, d #) -> J# s d + | i# >=# 0# = smallInteger i# + | otherwise = word2Integer x# where i# = word2Int# x# #else - = S# (word2Int# x#) + = smallInteger (word2Int# x#) #endif instance Bits Word32 where @@ -799,8 +795,7 @@ instance Num Word64 where abs x = x signum 0 = 0 signum _ = 1 - fromInteger (S# i#) = W64# (int2Word# i#) - fromInteger (J# s# d#) = W64# (integer2Word# s# d#) + fromInteger i = W64# (integerToWord i) instance Enum Word64 where succ x @@ -841,8 +836,8 @@ instance Integral Word64 where | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) | otherwise = divZeroError toInteger (W64# x#) - | i# >=# 0# = S# i# - | otherwise = case word2Integer# x# of (# s, d #) -> J# s d + | i# >=# 0# = smallInteger i# + | otherwise = wordToInteger x# where i# = word2Int# x# diff --git a/base.cabal b/base.cabal index 335ab39..00aa1f3 100644 --- a/base.cabal +++ b/base.cabal @@ -16,11 +16,8 @@ extra-tmp-files: Library { - -- This is actually something of a hack, as if we are using - -- GHC and we don't have an rts package for some reason, we - -- actually ought to fail. if impl(ghc) { - build-depends: rts + build-depends: rts, ghc-prim, integer exposed-modules: Data.Generics, Data.Generics.Aliases, -- 1.7.10.4