Commit 175e0450 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

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.
parent 6de7e264
......@@ -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.
......
......@@ -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
......@@ -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
-- <wired into compiler>:
-- 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
......@@ -771,20 +792,6 @@ asTypeOf :: a -> a -> a
asTypeOf = const
\end{code}
%*********************************************************
%* *
\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@}
......
......@@ -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
......
......@@ -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
......
......@@ -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]
......
......@@ -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
}