{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude, BangPatterns, UnboxedTuples,
             UnliftedFFITypes #-}

-- Commentary of Integer library is located on the wiki:
-- http://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/Integer
--
-- It gives an in-depth description of implementation details and
-- decisions.

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Integer.Type
-- Copyright   :  (c) Ian Lynagh 2007-2012
-- License     :  BSD3
--
-- Maintainer  :  igloo@earth.li
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- An simple definition of the 'Integer' type.
--
-----------------------------------------------------------------------------

#include "MachDeps.h"

module GHC.Integer.Type where

import GHC.Prim
import GHC.Classes
import GHC.Types
import GHC.Tuple ()
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
#endif

data Integer = Positive !Positive | Negative !Positive | Naught

-------------------------------------------------------------------
-- The hard work is done on positive numbers

-- Least significant bit is first

-- Positive's have the property that they contain at least one Bit,
-- and their last Bit is One.
type Positive = Digits
type Positives = List Positive

data Digits = Some !Digit !Digits
            | None
type Digit = Word#

-- XXX Could move [] above us
data List a = Nil | Cons a (List a)

mkInteger :: Bool   -- non-negative?
          -> [Int]  -- absolute value in 31 bit chunks, least significant first
                    -- ideally these would be Words rather than Ints, but
                    -- we don't have Word available at the moment.
          -> Integer
mkInteger :: Bool -> [Int] -> Integer
mkInteger Bool
nonNegative [Int]
is = let abs :: Integer
abs = [Int] -> Integer
f [Int]
is
                           in if Bool
nonNegative then Integer
abs else Integer -> Integer
negateInteger Integer
abs
    where f :: [Int] -> Integer
f [] = Integer
Naught
          f (I# Int#
i : [Int]
is') = Int# -> Integer
smallInteger Int#
i Integer -> Integer -> Integer
`orInteger` Integer -> Int# -> Integer
shiftLInteger ([Int] -> Integer
f [Int]
is') Int#
31#

errorInteger :: Integer
errorInteger :: Integer
errorInteger = Positive -> Integer
Positive Positive
errorPositive

errorPositive :: Positive
errorPositive :: Positive
errorPositive = Digit -> Positive -> Positive
Some Digit
47## Positive
None -- Random number

{-# NOINLINE smallInteger #-}
smallInteger :: Int# -> Integer
smallInteger :: Int# -> Integer
smallInteger Int#
i = if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
>=# Int#
0#) then Digit -> Integer
wordToInteger (Int# -> Digit
int2Word# Int#
i)
                 else -- XXX is this right for -minBound?
                      Integer -> Integer
negateInteger (Digit -> Integer
wordToInteger (Int# -> Digit
int2Word# (Int# -> Int#
negateInt# Int#
i)))

{-# NOINLINE wordToInteger #-}
wordToInteger :: Word# -> Integer
wordToInteger :: Digit -> Integer
wordToInteger Digit
w = if Int# -> Bool
isTrue# (Digit
w Digit -> Digit -> Int#
`eqWord#` Digit
0##)
                  then Integer
Naught
                  else Positive -> Integer
Positive (Digit -> Positive -> Positive
Some Digit
w Positive
None)

{-# NOINLINE integerToWord #-}
integerToWord :: Integer -> Word#
integerToWord :: Integer -> Digit
integerToWord (Positive (Some Digit
w Positive
_)) = Digit
w
integerToWord (Negative (Some Digit
w Positive
_)) = Digit
0## Digit -> Digit -> Digit
`minusWord#` Digit
w
-- Must be Naught by the invariant:
integerToWord Integer
_ = Digit
0##

{-# NOINLINE integerToInt #-}
integerToInt :: Integer -> Int#
integerToInt :: Integer -> Int#
integerToInt Integer
i = Digit -> Int#
word2Int# (Integer -> Digit
integerToWord Integer
i)

#if WORD_SIZE_IN_BITS == 64
-- Nothing
#elif WORD_SIZE_IN_BITS == 32
{-# NOINLINE integerToWord64 #-}
integerToWord64 :: Integer -> Word64#
integerToWord64 i = int64ToWord64# (integerToInt64 i)

{-# NOINLINE word64ToInteger #-}
word64ToInteger:: Word64# -> Integer
word64ToInteger w = if isTrue# (w `eqWord64#` wordToWord64# 0##)
                    then Naught
                    else Positive (word64ToPositive w)

{-# NOINLINE integerToInt64 #-}
integerToInt64 :: Integer -> Int64#
integerToInt64 Naught = intToInt64# 0#
integerToInt64 (Positive p) = word64ToInt64# (positiveToWord64 p)
integerToInt64 (Negative p)
    = negateInt64# (word64ToInt64# (positiveToWord64 p))

{-# NOINLINE int64ToInteger #-}
int64ToInteger :: Int64# -> Integer
int64ToInteger i
 = if isTrue# (i `eqInt64#` intToInt64# 0#)
   then Naught
   else if isTrue# (i `gtInt64#` intToInt64# 0#)
   then Positive (word64ToPositive (int64ToWord64# i))
   else Negative (word64ToPositive (int64ToWord64# (negateInt64# i)))
#else
#error WORD_SIZE_IN_BITS not supported
#endif

oneInteger :: Integer
oneInteger :: Integer
oneInteger = Positive -> Integer
Positive Positive
onePositive

negativeOneInteger :: Integer
negativeOneInteger :: Integer
negativeOneInteger = Positive -> Integer
Negative Positive
onePositive

twoToTheThirtytwoInteger :: Integer
twoToTheThirtytwoInteger :: Integer
twoToTheThirtytwoInteger = Positive -> Integer
Positive Positive
twoToTheThirtytwoPositive

{-# NOINLINE encodeDoubleInteger #-}
encodeDoubleInteger :: Integer -> Int# -> Double#
encodeDoubleInteger :: Integer -> Int# -> Double#
encodeDoubleInteger (Positive Positive
ds0) Int#
e0 = Double# -> Positive -> Int# -> Double#
f Double#
0.0## Positive
ds0 Int#
e0
    where f :: Double# -> Positive -> Int# -> Double#
f !Double#
acc Positive
None        (!Int#
_) = Double#
acc
          f !Double#
acc (Some Digit
d Positive
ds) !Int#
e   = Double# -> Positive -> Int# -> Double#
f (Double#
acc Double# -> Double# -> Double#
+## Digit -> Int# -> Double#
encodeDouble# Digit
d Int#
e)
                                      Positive
ds
                                      -- XXX We assume that this adding to e
                                      -- isn't going to overflow
                                      (Int#
e Int# -> Int# -> Int#
+# WORD_SIZE_IN_BITS#)
encodeDoubleInteger (Negative Positive
ds) Int#
e
    = Double# -> Double#
negateDouble# (Integer -> Int# -> Double#
encodeDoubleInteger (Positive -> Integer
Positive Positive
ds) Int#
e)
encodeDoubleInteger Integer
Naught Int#
_ = Double#
0.0##

foreign import ccall unsafe "__word_encodeDouble"
        encodeDouble# :: Word# -> Int# -> Double#

{-# NOINLINE encodeFloatInteger #-}
encodeFloatInteger :: Integer -> Int# -> Float#
encodeFloatInteger :: Integer -> Int# -> Float#
encodeFloatInteger (Positive Positive
ds0) Int#
e0 = Float# -> Positive -> Int# -> Float#
f Float#
0.0# Positive
ds0 Int#
e0
    where f :: Float# -> Positive -> Int# -> Float#
f !Float#
acc Positive
None        (!Int#
_) = Float#
acc
          f !Float#
acc (Some Digit
d Positive
ds) !Int#
e   = Float# -> Positive -> Int# -> Float#
f (Float#
acc Float# -> Float# -> Float#
`plusFloat#` Digit -> Int# -> Float#
encodeFloat# Digit
d Int#
e)
                                      Positive
ds
                                      -- XXX We assume that this adding to e
                                      -- isn't going to overflow
                                      (Int#
e Int# -> Int# -> Int#
+# WORD_SIZE_IN_BITS#)
encodeFloatInteger (Negative Positive
ds) Int#
e
    = Float# -> Float#
negateFloat# (Integer -> Int# -> Float#
encodeFloatInteger (Positive -> Integer
Positive Positive
ds) Int#
e)
encodeFloatInteger Integer
Naught Int#
_ = Float#
0.0#

foreign import ccall unsafe "__word_encodeFloat"
    encodeFloat# :: Word# -> Int# -> Float#

{-# NOINLINE decodeFloatInteger #-}
decodeFloatInteger :: Float# -> (# Integer, Int# #)
decodeFloatInteger :: Float# -> (# Integer, Int# #)
decodeFloatInteger Float#
f = case Float# -> (# Int#, Int# #)
decodeFloat_Int# Float#
f of
                       (# Int#
mant, Int#
exp #) -> (# Int# -> Integer
smallInteger Int#
mant, Int#
exp #)

-- XXX This could be optimised better, by either (word-size dependent)
-- using single 64bit value for the mantissa, or doing the multiplication
-- by just building the Digits directly
{-# NOINLINE decodeDoubleInteger #-}
decodeDoubleInteger :: Double# -> (# Integer, Int# #)
decodeDoubleInteger :: Double# -> (# Integer, Int# #)
decodeDoubleInteger Double#
d
 = case Double# -> (# Int#, Digit, Digit, Int# #)
decodeDouble_2Int# Double#
d of
   (# Int#
mantSign, Digit
mantHigh, Digit
mantLow, Int#
exp #) ->
       (# (Int# -> Integer
smallInteger Int#
mantSign) Integer -> Integer -> Integer
`timesInteger`
          (  (Digit -> Integer
wordToInteger Digit
mantHigh Integer -> Integer -> Integer
`timesInteger` Integer
twoToTheThirtytwoInteger)
             Integer -> Integer -> Integer
`plusInteger` Digit -> Integer
wordToInteger Digit
mantLow),
          Int#
exp #)

{-# NOINLINE doubleFromInteger #-}
doubleFromInteger :: Integer -> Double#
doubleFromInteger :: Integer -> Double#
doubleFromInteger Integer
Naught = Double#
0.0##
doubleFromInteger (Positive Positive
p) = Positive -> Double#
doubleFromPositive Positive
p
doubleFromInteger (Negative Positive
p) = Double# -> Double#
negateDouble# (Positive -> Double#
doubleFromPositive Positive
p)

{-# NOINLINE floatFromInteger #-}
floatFromInteger :: Integer -> Float#
floatFromInteger :: Integer -> Float#
floatFromInteger Integer
Naught = Float#
0.0#
floatFromInteger (Positive Positive
p) = Positive -> Float#
floatFromPositive Positive
p
floatFromInteger (Negative Positive
p) = Float# -> Float#
negateFloat# (Positive -> Float#
floatFromPositive Positive
p)

{-# NOINLINE andInteger #-}
andInteger :: Integer -> Integer -> Integer
Integer
Naught     andInteger :: Integer -> Integer -> Integer
`andInteger` (!Integer
_)       = Integer
Naught
(!Integer
_)       `andInteger` Integer
Naught     = Integer
Naught
Positive Positive
x `andInteger` Positive Positive
y = Positive -> Integer
digitsToInteger (Positive
x Positive -> Positive -> Positive
`andDigits` Positive
y)
{-
To calculate x & -y we need to calculate
    x & twosComplement y
The (imaginary) sign bits are 0 and 1, so &ing them give 0, i.e. positive.
Note that
    twosComplement y
has infinitely many 1s, but x has a finite number of digits, so andDigits
will return a finite result.
-}
Positive Positive
x `andInteger` Negative Positive
y = let y' :: DigitsOnes
y' = Positive -> DigitsOnes
twosComplementPositive Positive
y
                                         z :: Positive
z = DigitsOnes
y' DigitsOnes -> Positive -> Positive
`andDigitsOnes` Positive
x
                                     in Positive -> Integer
digitsToInteger Positive
z
Negative Positive
x `andInteger` Positive Positive
y = Positive -> Integer
Positive Positive
y Integer -> Integer -> Integer
`andInteger` Positive -> Integer
Negative Positive
x
{-
To calculate -x & -y, naively we need to calculate
    twosComplement (twosComplement x & twosComplement y)
but
    twosComplement x & twosComplement y
has infinitely many 1s, so this won't work. Thus we use de Morgan's law
to get
    -x & -y = !(!(-x) | !(-y))
            = !(!(twosComplement x) | !(twosComplement y))
            = !(!(!x + 1) | (!y + 1))
            = !((x - 1) | (y - 1))
but the result is negative, so we need to take the two's complement of
this in order to get the magnitude of the result.
    twosComplement !((x - 1) | (y - 1))
            = !(!((x - 1) | (y - 1))) + 1
            = ((x - 1) | (y - 1)) + 1
-}
-- We don't know that x and y are /strictly/ greater than 1, but
-- minusPositive gives us the required answer anyway.
Negative Positive
x `andInteger` Negative Positive
y = let x' :: Positive
x' = Positive
x Positive -> Positive -> Positive
`minusPositive` Positive
onePositive
                                         y' :: Positive
y' = Positive
y Positive -> Positive -> Positive
`minusPositive` Positive
onePositive
                                         z :: Positive
z = Positive
x' Positive -> Positive -> Positive
`orDigits` Positive
y'
                                         -- XXX Cheating the precondition:
                                         z' :: Positive
z' = Positive -> Positive
succPositive Positive
z
                                     in Positive -> Integer
digitsToNegativeInteger Positive
z'

{-# NOINLINE orInteger #-}
orInteger :: Integer -> Integer -> Integer
Integer
Naught     orInteger :: Integer -> Integer -> Integer
`orInteger` (!Integer
i)       = Integer
i
(!Integer
i)       `orInteger` Integer
Naught     = Integer
i
Positive Positive
x `orInteger` Positive Positive
y = Positive -> Integer
Positive (Positive
x Positive -> Positive -> Positive
`orDigits` Positive
y)
{-
x | -y = - (twosComplement (x | twosComplement y))
       = - (twosComplement !(!x & !(twosComplement y)))
       = - (twosComplement !(!x & !(!y + 1)))
       = - (twosComplement !(!x & (y - 1)))
       = - ((!x & (y - 1)) + 1)
-}
Positive Positive
x `orInteger` Negative Positive
y = let x' :: DigitsOnes
x' = Positive -> DigitsOnes
flipBits Positive
x
                                        y' :: Positive
y' = Positive
y Positive -> Positive -> Positive
`minusPositive` Positive
onePositive
                                        z :: Positive
z = DigitsOnes
x' DigitsOnes -> Positive -> Positive
`andDigitsOnes` Positive
y'
                                        z' :: Positive
z' = Positive -> Positive
succPositive Positive
z
                                    in Positive -> Integer
digitsToNegativeInteger Positive
z'
Negative Positive
x `orInteger` Positive Positive
y = Positive -> Integer
Positive Positive
y Integer -> Integer -> Integer
`orInteger` Positive -> Integer
Negative Positive
x
{-
-x | -y = - (twosComplement (twosComplement x | twosComplement y))
        = - (twosComplement !(!(twosComplement x) & !(twosComplement y)))
        = - (twosComplement !(!(!x + 1) & !(!y + 1)))
        = - (twosComplement !((x - 1) & (y - 1)))
        = - (((x - 1) & (y - 1)) + 1)
-}
Negative Positive
x `orInteger` Negative Positive
y = let x' :: Positive
x' = Positive
x Positive -> Positive -> Positive
`minusPositive` Positive
onePositive
                                        y' :: Positive
y' = Positive
y Positive -> Positive -> Positive
`minusPositive` Positive
onePositive
                                        z :: Positive
z = Positive
x' Positive -> Positive -> Positive
`andDigits` Positive
y'
                                        z' :: Positive
z' = Positive -> Positive
succPositive Positive
z
                                    in Positive -> Integer
digitsToNegativeInteger Positive
z'

{-# NOINLINE xorInteger #-}
xorInteger :: Integer -> Integer -> Integer
Integer
Naught     xorInteger :: Integer -> Integer -> Integer
`xorInteger` (!Integer
i)       = Integer
i
(!Integer
i)       `xorInteger` Integer
Naught     = Integer
i
Positive Positive
x `xorInteger` Positive Positive
y = Positive -> Integer
digitsToInteger (Positive
x Positive -> Positive -> Positive
`xorDigits` Positive
y)
{-
x ^ -y = - (twosComplement (x ^ twosComplement y))
       = - (twosComplement !(x ^ !(twosComplement y)))
       = - (twosComplement !(x ^ !(!y + 1)))
       = - (twosComplement !(x ^ (y - 1)))
       = - ((x ^ (y - 1)) + 1)
-}
Positive Positive
x `xorInteger` Negative Positive
y = let y' :: Positive
y' = Positive
y Positive -> Positive -> Positive
`minusPositive` Positive
onePositive
                                         z :: Positive
z = Positive
x Positive -> Positive -> Positive
`xorDigits` Positive
y'
                                         z' :: Positive
z' = Positive -> Positive
succPositive Positive
z
                                     in Positive -> Integer
digitsToNegativeInteger Positive
z'
Negative Positive
x `xorInteger` Positive Positive
y = Positive -> Integer
Positive Positive
y Integer -> Integer -> Integer
`xorInteger` Positive -> Integer
Negative Positive
x
{-
-x ^ -y = twosComplement x ^ twosComplement y
        = (!x + 1) ^ (!y + 1)
        = (!x + 1) ^ (!y + 1)
        = !(!x + 1) ^ !(!y + 1)
        = (x - 1) ^ (y - 1)
-}
Negative Positive
x `xorInteger` Negative Positive
y = let x' :: Positive
x' = Positive
x Positive -> Positive -> Positive
`minusPositive` Positive
onePositive
                                         y' :: Positive
y' = Positive
y Positive -> Positive -> Positive
`minusPositive` Positive
onePositive
                                         z :: Positive
z = Positive
x' Positive -> Positive -> Positive
`xorDigits` Positive
y'
                                     in Positive -> Integer
digitsToInteger Positive
z

{-# NOINLINE complementInteger #-}
complementInteger :: Integer -> Integer
complementInteger :: Integer -> Integer
complementInteger Integer
x = Integer
negativeOneInteger Integer -> Integer -> Integer
`minusInteger` Integer
x

{-# NOINLINE shiftLInteger #-}
shiftLInteger :: Integer -> Int# -> Integer
shiftLInteger :: Integer -> Int# -> Integer
shiftLInteger (Positive Positive
p) Int#
i = Positive -> Integer
Positive (Positive -> Int# -> Positive
shiftLPositive Positive
p Int#
i)
shiftLInteger (Negative Positive
n) Int#
i = Positive -> Integer
Negative (Positive -> Int# -> Positive
shiftLPositive Positive
n Int#
i)
shiftLInteger Integer
Naught       Int#
_ = Integer
Naught

{-# NOINLINE shiftRInteger #-}
shiftRInteger :: Integer -> Int# -> Integer
shiftRInteger :: Integer -> Int# -> Integer
shiftRInteger (Positive Positive
p)   Int#
i = Positive -> Int# -> Integer
shiftRPositive Positive
p Int#
i
shiftRInteger j :: Integer
j@(Negative Positive
_) Int#
i
    = Integer -> Integer
complementInteger (Integer -> Int# -> Integer
shiftRInteger (Integer -> Integer
complementInteger Integer
j) Int#
i)
shiftRInteger Integer
Naught         Int#
_ = Integer
Naught

-- XXX this could be a lot more efficient, but this is a quick
-- reimplementation of the default Data.Bits instance, so that we can
-- implement the Integer interface
testBitInteger :: Integer -> Int# -> Bool
testBitInteger :: Integer -> Int# -> Bool
testBitInteger Integer
x Int#
i = (Integer
x Integer -> Integer -> Integer
`andInteger` (Integer
oneInteger Integer -> Int# -> Integer
`shiftLInteger` Int#
i))
        Integer -> Integer -> Bool
`neqInteger` Integer
Naught

twosComplementPositive :: Positive -> DigitsOnes
twosComplementPositive :: Positive -> DigitsOnes
twosComplementPositive Positive
p = Positive -> DigitsOnes
flipBits (Positive
p Positive -> Positive -> Positive
`minusPositive` Positive
onePositive)

flipBits :: Digits -> DigitsOnes
flipBits :: Positive -> DigitsOnes
flipBits Positive
ds = Positive -> DigitsOnes
DigitsOnes (Positive -> Positive
flipBitsDigits Positive
ds)

flipBitsDigits :: Digits -> Digits
flipBitsDigits :: Positive -> Positive
flipBitsDigits Positive
None = Positive
None
flipBitsDigits (Some Digit
w Positive
ws) = Digit -> Positive -> Positive
Some (Digit -> Digit
not# Digit
w) (Positive -> Positive
flipBitsDigits Positive
ws)

{-# NOINLINE negateInteger #-}
negateInteger :: Integer -> Integer
negateInteger :: Integer -> Integer
negateInteger (Positive Positive
p) = Positive -> Integer
Negative Positive
p
negateInteger (Negative Positive
p) = Positive -> Integer
Positive Positive
p
negateInteger Integer
Naught       = Integer
Naught

-- Note [Avoid patError]
{-# NOINLINE plusInteger #-}
plusInteger :: Integer -> Integer -> Integer
Positive Positive
p1    plusInteger :: Integer -> Integer -> Integer
`plusInteger` Positive Positive
p2 = Positive -> Integer
Positive (Positive
p1 Positive -> Positive -> Positive
`plusPositive` Positive
p2)
Negative Positive
p1    `plusInteger` Negative Positive
p2 = Positive -> Integer
Negative (Positive
p1 Positive -> Positive -> Positive
`plusPositive` Positive
p2)
Positive Positive
p1    `plusInteger` Negative Positive
p2
    = case Positive
p1 Positive -> Positive -> Ordering
`comparePositive` Positive
p2 of
      Ordering
GT -> Positive -> Integer
Positive (Positive
p1 Positive -> Positive -> Positive
`minusPositive` Positive
p2)
      Ordering
EQ -> Integer
Naught
      Ordering
LT -> Positive -> Integer
Negative (Positive
p2 Positive -> Positive -> Positive
`minusPositive` Positive
p1)
Negative Positive
p1    `plusInteger` Positive Positive
p2
    = Positive -> Integer
Positive Positive
p2 Integer -> Integer -> Integer
`plusInteger` Positive -> Integer
Negative Positive
p1
Integer
Naught         `plusInteger` Integer
Naught         = Integer
Naught
Integer
Naught         `plusInteger` i :: Integer
i@(Positive Positive
_) = Integer
i
Integer
Naught         `plusInteger` i :: Integer
i@(Negative Positive
_) = Integer
i
i :: Integer
i@(Positive Positive
_) `plusInteger` Integer
Naught         = Integer
i
i :: Integer
i@(Negative Positive
_) `plusInteger` Integer
Naught         = Integer
i

{-# NOINLINE minusInteger #-}
minusInteger :: Integer -> Integer -> Integer
Integer
i1 minusInteger :: Integer -> Integer -> Integer
`minusInteger` Integer
i2 = Integer
i1 Integer -> Integer -> Integer
`plusInteger` Integer -> Integer
negateInteger Integer
i2

{-# NOINLINE timesInteger #-}
timesInteger :: Integer -> Integer -> Integer
Positive Positive
p1 timesInteger :: Integer -> Integer -> Integer
`timesInteger` Positive Positive
p2 = Positive -> Integer
Positive (Positive
p1 Positive -> Positive -> Positive
`timesPositive` Positive
p2)
Negative Positive
p1 `timesInteger` Negative Positive
p2 = Positive -> Integer
Positive (Positive
p1 Positive -> Positive -> Positive
`timesPositive` Positive
p2)
Positive Positive
p1 `timesInteger` Negative Positive
p2 = Positive -> Integer
Negative (Positive
p1 Positive -> Positive -> Positive
`timesPositive` Positive
p2)
Negative Positive
p1 `timesInteger` Positive Positive
p2 = Positive -> Integer
Negative (Positive
p1 Positive -> Positive -> Positive
`timesPositive` Positive
p2)
(!Integer
_)        `timesInteger` (!Integer
_)        = Integer
Naught

{-# NOINLINE divModInteger #-}
divModInteger :: Integer -> Integer -> (# Integer, Integer #)
Integer
n divModInteger :: Integer -> Integer -> (# Integer, Integer #)
`divModInteger` Integer
d =
    case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
d of
        (# Integer
q, Integer
r #) ->
            if Integer -> Integer
signumInteger Integer
r Integer -> Integer -> Bool
`eqInteger`
               Integer -> Integer
negateInteger (Integer -> Integer
signumInteger Integer
d)
            then (# Integer
q Integer -> Integer -> Integer
`minusInteger` Integer
oneInteger, Integer
r Integer -> Integer -> Integer
`plusInteger` Integer
d #)
            else (# Integer
q, Integer
r #)

{-# NOINLINE divInteger #-}
divInteger :: Integer -> Integer -> Integer
Integer
n divInteger :: Integer -> Integer -> Integer
`divInteger` Integer
d = Integer
quotient
    where (# Integer
quotient, Integer
_ #) = Integer
n Integer -> Integer -> (# Integer, Integer #)
`divModInteger` Integer
d

{-# NOINLINE modInteger #-}
modInteger :: Integer -> Integer -> Integer
Integer
n modInteger :: Integer -> Integer -> Integer
`modInteger` Integer
d = Integer
modulus
    where (# Integer
_, Integer
modulus #) = Integer
n Integer -> Integer -> (# Integer, Integer #)
`divModInteger` Integer
d

{-# NOINLINE quotRemInteger #-}
quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
Integer
Naught      quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` (!Integer
_)        = (# Integer
Naught, Integer
Naught #)
(!Integer
_)        `quotRemInteger` Integer
Naught
    = (# Integer
errorInteger, Integer
errorInteger #) -- XXX Can't happen
-- XXX _            `quotRemInteger` Naught     = error "Division by zero"
Positive Positive
p1 `quotRemInteger` Positive Positive
p2 = Positive
p1 Positive -> Positive -> (# Integer, Integer #)
`quotRemPositive` Positive
p2
Negative Positive
p1 `quotRemInteger` Positive Positive
p2 = case Positive
p1 Positive -> Positive -> (# Integer, Integer #)
`quotRemPositive` Positive
p2 of
                                           (# Integer
q, Integer
r #) ->
                                               (# Integer -> Integer
negateInteger Integer
q,
                                                  Integer -> Integer
negateInteger Integer
r #)
Positive Positive
p1 `quotRemInteger` Negative Positive
p2 = case Positive
p1 Positive -> Positive -> (# Integer, Integer #)
`quotRemPositive` Positive
p2 of
                                           (# Integer
q, Integer
r #) ->
                                               (# Integer -> Integer
negateInteger Integer
q, Integer
r #)
Negative Positive
p1 `quotRemInteger` Negative Positive
p2 = case Positive
p1 Positive -> Positive -> (# Integer, Integer #)
`quotRemPositive` Positive
p2 of
                                           (# Integer
q, Integer
r #) ->
                                               (# Integer
q, Integer -> Integer
negateInteger Integer
r #)

{-# NOINLINE quotInteger #-}
quotInteger :: Integer -> Integer -> Integer
Integer
x quotInteger :: Integer -> Integer -> Integer
`quotInteger` Integer
y = case Integer
x Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
y of
                    (# Integer
q, Integer
_ #) -> Integer
q

{-# NOINLINE remInteger #-}
remInteger :: Integer -> Integer -> Integer
Integer
x remInteger :: Integer -> Integer -> Integer
`remInteger` Integer
y = case Integer
x Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
y of
                   (# Integer
_, Integer
r #) -> Integer
r

{-# NOINLINE compareInteger #-}
compareInteger :: Integer -> Integer -> Ordering
Positive Positive
x compareInteger :: Integer -> Integer -> Ordering
`compareInteger` Positive Positive
y = Positive
x Positive -> Positive -> Ordering
`comparePositive` Positive
y
Positive Positive
_ `compareInteger` (!Integer
_)       = Ordering
GT
Integer
Naught     `compareInteger` Integer
Naught     = Ordering
EQ
Integer
Naught     `compareInteger` Negative Positive
_ = Ordering
GT
Negative Positive
x `compareInteger` Negative Positive
y = Positive
y Positive -> Positive -> Ordering
`comparePositive` Positive
x
(!Integer
_)       `compareInteger` (!Integer
_)       = Ordering
LT

{-# NOINLINE eqInteger# #-}
eqInteger# :: Integer -> Integer -> Int#
Integer
x eqInteger# :: Integer -> Integer -> Int#
`eqInteger#` Integer
y = case Integer
x Integer -> Integer -> Ordering
`compareInteger` Integer
y of
                        Ordering
EQ -> Int#
1#
                        Ordering
_  -> Int#
0#

{-# NOINLINE neqInteger# #-}
neqInteger# :: Integer -> Integer -> Int#
Integer
x neqInteger# :: Integer -> Integer -> Int#
`neqInteger#` Integer
y = case Integer
x Integer -> Integer -> Ordering
`compareInteger` Integer
y of
                         Ordering
EQ -> Int#
0#
                         Ordering
_  -> Int#
1#

{-# INLINE eqInteger  #-}
{-# INLINE neqInteger #-}
eqInteger, neqInteger :: Integer -> Integer -> Bool
eqInteger :: Integer -> Integer -> Bool
eqInteger  Integer
a Integer
b = Int# -> Bool
isTrue# (Integer
a Integer -> Integer -> Int#
`eqInteger#`  Integer
b)
neqInteger :: Integer -> Integer -> Bool
neqInteger Integer
a Integer
b = Int# -> Bool
isTrue# (Integer
a Integer -> Integer -> Int#
`neqInteger#` Integer
b)

instance  Eq Integer  where
    == :: Integer -> Integer -> Bool
(==) = Integer -> Integer -> Bool
eqInteger
    /= :: Integer -> Integer -> Bool
(/=) = Integer -> Integer -> Bool
neqInteger

{-# NOINLINE ltInteger# #-}
ltInteger# :: Integer -> Integer -> Int#
Integer
x ltInteger# :: Integer -> Integer -> Int#
`ltInteger#` Integer
y = case Integer
x Integer -> Integer -> Ordering
`compareInteger` Integer
y of
                        Ordering
LT -> Int#
1#
                        Ordering
_  -> Int#
0#

{-# NOINLINE gtInteger# #-}
gtInteger# :: Integer -> Integer -> Int#
Integer
x gtInteger# :: Integer -> Integer -> Int#
`gtInteger#` Integer
y = case Integer
x Integer -> Integer -> Ordering
`compareInteger` Integer
y of
                        Ordering
GT -> Int#
1#
                        Ordering
_  -> Int#
0#

{-# NOINLINE leInteger# #-}
leInteger# :: Integer -> Integer -> Int#
Integer
x leInteger# :: Integer -> Integer -> Int#
`leInteger#` Integer
y = case Integer
x Integer -> Integer -> Ordering
`compareInteger` Integer
y of
                        Ordering
GT -> Int#
0#
                        Ordering
_  -> Int#
1#

{-# NOINLINE geInteger# #-}
geInteger# :: Integer -> Integer -> Int#
Integer
x geInteger# :: Integer -> Integer -> Int#
`geInteger#` Integer
y = case Integer
x Integer -> Integer -> Ordering
`compareInteger` Integer
y of
                        Ordering
LT -> Int#
0#
                        Ordering
_  -> Int#
1#

{-# INLINE leInteger #-}
{-# INLINE ltInteger #-}
{-# INLINE geInteger #-}
{-# INLINE gtInteger #-}
leInteger, gtInteger, ltInteger, geInteger :: Integer -> Integer -> Bool
leInteger :: Integer -> Integer -> Bool
leInteger Integer
a Integer
b = Int# -> Bool
isTrue# (Integer
a Integer -> Integer -> Int#
`leInteger#` Integer
b)
gtInteger :: Integer -> Integer -> Bool
gtInteger Integer
a Integer
b = Int# -> Bool
isTrue# (Integer
a Integer -> Integer -> Int#
`gtInteger#` Integer
b)
ltInteger :: Integer -> Integer -> Bool
ltInteger Integer
a Integer
b = Int# -> Bool
isTrue# (Integer
a Integer -> Integer -> Int#
`ltInteger#` Integer
b)
geInteger :: Integer -> Integer -> Bool
geInteger Integer
a Integer
b = Int# -> Bool
isTrue# (Integer
a Integer -> Integer -> Int#
`geInteger#` Integer
b)

instance Ord Integer where
    <= :: Integer -> Integer -> Bool
(<=) = Integer -> Integer -> Bool
leInteger
    > :: Integer -> Integer -> Bool
(>)  = Integer -> Integer -> Bool
gtInteger
    < :: Integer -> Integer -> Bool
(<)  = Integer -> Integer -> Bool
ltInteger
    >= :: Integer -> Integer -> Bool
(>=) = Integer -> Integer -> Bool
geInteger
    compare :: Integer -> Integer -> Ordering
compare = Integer -> Integer -> Ordering
compareInteger

{-# NOINLINE absInteger #-}
absInteger :: Integer -> Integer
absInteger :: Integer -> Integer
absInteger (Negative Positive
x) = Positive -> Integer
Positive Positive
x
absInteger Integer
x = Integer
x

{-# NOINLINE signumInteger #-}
signumInteger :: Integer -> Integer
signumInteger :: Integer -> Integer
signumInteger (Negative Positive
_) = Integer
negativeOneInteger
signumInteger Integer
Naught       = Integer
Naught
signumInteger (Positive Positive
_) = Integer
oneInteger

{-# NOINLINE hashInteger #-}
hashInteger :: Integer -> Int#
hashInteger :: Integer -> Int#
hashInteger = Integer -> Int#
integerToInt

-------------------------------------------------------------------
-- The hard work is done on positive numbers

onePositive :: Positive
onePositive :: Positive
onePositive = Digit -> Positive -> Positive
Some Digit
1## Positive
None

halfBoundUp, fullBound :: () -> Digit
lowHalfMask :: () -> Digit
highHalfShift :: () -> Int#
twoToTheThirtytwoPositive :: Positive
#if WORD_SIZE_IN_BITS == 64
halfBoundUp :: () -> Digit
halfBoundUp   () = Digit
0x8000000000000000##
fullBound :: () -> Digit
fullBound     () = Digit
0xFFFFFFFFFFFFFFFF##
lowHalfMask :: () -> Digit
lowHalfMask   () = Digit
0xFFFFFFFF##
highHalfShift :: () -> Int#
highHalfShift () = Int#
32#
twoToTheThirtytwoPositive :: Positive
twoToTheThirtytwoPositive = Digit -> Positive -> Positive
Some Digit
0x100000000## Positive
None
#elif WORD_SIZE_IN_BITS == 32
halfBoundUp   () = 0x80000000##
fullBound     () = 0xFFFFFFFF##
lowHalfMask   () = 0xFFFF##
highHalfShift () = 16#
twoToTheThirtytwoPositive = Some 0## (Some 1## None)
#else
#error Unhandled WORD_SIZE_IN_BITS
#endif

digitsMaybeZeroToInteger :: Digits -> Integer
digitsMaybeZeroToInteger :: Positive -> Integer
digitsMaybeZeroToInteger Positive
None = Integer
Naught
digitsMaybeZeroToInteger Positive
ds = Positive -> Integer
Positive Positive
ds

digitsToInteger :: Digits -> Integer
digitsToInteger :: Positive -> Integer
digitsToInteger Positive
ds = case Positive -> Positive
removeZeroTails Positive
ds of
                     Positive
None -> Integer
Naught
                     Positive
ds' -> Positive -> Integer
Positive Positive
ds'

digitsToNegativeInteger :: Digits -> Integer
digitsToNegativeInteger :: Positive -> Integer
digitsToNegativeInteger Positive
ds = case Positive -> Positive
removeZeroTails Positive
ds of
                             Positive
None -> Integer
Naught
                             Positive
ds' -> Positive -> Integer
Negative Positive
ds'

removeZeroTails :: Digits -> Digits
removeZeroTails :: Positive -> Positive
removeZeroTails (Some Digit
w Positive
ds) = if Int# -> Bool
isTrue# (Digit
w Digit -> Digit -> Int#
`eqWord#` Digit
0##)
                              then case Positive -> Positive
removeZeroTails Positive
ds of
                                   Positive
None -> Positive
None
                                   Positive
ds' -> Digit -> Positive -> Positive
Some Digit
w Positive
ds'
                              else Digit -> Positive -> Positive
Some Digit
w (Positive -> Positive
removeZeroTails Positive
ds)
removeZeroTails Positive
None = Positive
None

#if WORD_SIZE_IN_BITS < 64
word64ToPositive :: Word64# -> Positive
word64ToPositive w
 = if isTrue# (w `eqWord64#` wordToWord64# 0##)
   then None
   else Some (word64ToWord# w) (word64ToPositive (w `uncheckedShiftRL64#` 32#))

positiveToWord64 :: Positive -> Word64#
positiveToWord64 None = wordToWord64# 0## -- XXX Can't happen
positiveToWord64 (Some w None) = wordToWord64# w
positiveToWord64 (Some low (Some high _))
    = wordToWord64# low `or64#` (wordToWord64# high `uncheckedShiftL64#` 32#)
#endif

-- Note [Avoid patError]
comparePositive :: Positive -> Positive -> Ordering
Some Digit
x Positive
xs comparePositive :: Positive -> Positive -> Ordering
`comparePositive` Some Digit
y Positive
ys = case Positive
xs Positive -> Positive -> Ordering
`comparePositive` Positive
ys of
                                        Ordering
EQ ->      if Int# -> Bool
isTrue# (Digit
x Digit -> Digit -> Int#
`ltWord#` Digit
y) then Ordering
LT
                                              else if Int# -> Bool
isTrue# (Digit
x Digit -> Digit -> Int#
`gtWord#` Digit
y) then Ordering
GT
                                              else                                 Ordering
EQ
                                        Ordering
res -> Ordering
res
Positive
None      `comparePositive` Positive
None      = Ordering
EQ
(Some {}) `comparePositive` Positive
None      = Ordering
GT
Positive
None      `comparePositive` (Some {}) = Ordering
LT

plusPositive :: Positive -> Positive -> Positive
plusPositive :: Positive -> Positive -> Positive
plusPositive Positive
x0 Positive
y0 = Digit -> Positive -> Positive -> Positive
addWithCarry Digit
0## Positive
x0 Positive
y0
 where -- digit `elem` [0, 1]
       -- Note [Avoid patError]
       addWithCarry :: Digit -> Positive -> Positive -> Positive
       addWithCarry :: Digit -> Positive -> Positive -> Positive
addWithCarry Digit
c Positive
None            Positive
None            = Digit -> Positive -> Positive
addOnCarry Digit
c Positive
None
       addWithCarry Digit
c xs :: Positive
xs@(Some {})    Positive
None            = Digit -> Positive -> Positive
addOnCarry Digit
c Positive
xs
       addWithCarry Digit
c Positive
None            ys :: Positive
ys@(Some {})    = Digit -> Positive -> Positive
addOnCarry Digit
c Positive
ys
       addWithCarry Digit
c xs :: Positive
xs@(Some Digit
x Positive
xs') ys :: Positive
ys@(Some Digit
y Positive
ys')
        = if Int# -> Bool
isTrue# (Digit
x Digit -> Digit -> Int#
`ltWord#` Digit
y) then Digit -> Positive -> Positive -> Positive
addWithCarry Digit
c Positive
ys Positive
xs
          -- Now x >= y
          else if Int# -> Bool
isTrue# (Digit
y Digit -> Digit -> Int#
`geWord#` () -> Digit
halfBoundUp ())
               -- So they are both at least halfBoundUp, so we subtract
               -- halfBoundUp from each and thus carry 1
               then case Digit
x Digit -> Digit -> Digit
`minusWord#` () -> Digit
halfBoundUp () of
                    Digit
x' ->
                     case Digit
y Digit -> Digit -> Digit
`minusWord#` () -> Digit
halfBoundUp () of
                     Digit
y' ->
                      case Digit
x' Digit -> Digit -> Digit
`plusWord#` Digit
y' Digit -> Digit -> Digit
`plusWord#` Digit
c of
                      Digit
this ->
                       Digit -> Positive -> Positive
Some Digit
this Positive
withCarry
          else if Int# -> Bool
isTrue# (Digit
x Digit -> Digit -> Int#
`geWord#` () -> Digit
halfBoundUp ())
               then case Digit
x Digit -> Digit -> Digit
`minusWord#` () -> Digit
halfBoundUp () of
                    Digit
x' ->
                     case Digit
x' Digit -> Digit -> Digit
`plusWord#` Digit
y Digit -> Digit -> Digit
`plusWord#` Digit
c of
                     Digit
z ->
                      -- We've taken off halfBoundUp, so now we need to
                      -- add it back on
                      if Int# -> Bool
isTrue# (Digit
z Digit -> Digit -> Int#
`ltWord#` () -> Digit
halfBoundUp ())
                       then Digit -> Positive -> Positive
Some (Digit
z Digit -> Digit -> Digit
`plusWord#`  () -> Digit
halfBoundUp ()) Positive
withoutCarry
                       else Digit -> Positive -> Positive
Some (Digit
z Digit -> Digit -> Digit
`minusWord#` () -> Digit
halfBoundUp ()) Positive
withCarry
          else Digit -> Positive -> Positive
Some (Digit
x Digit -> Digit -> Digit
`plusWord#` Digit
y Digit -> Digit -> Digit
`plusWord#` Digit
c) Positive
withoutCarry
           where withCarry :: Positive
withCarry    = Digit -> Positive -> Positive -> Positive
addWithCarry Digit
1## Positive
xs' Positive
ys'
                 withoutCarry :: Positive
withoutCarry = Digit -> Positive -> Positive -> Positive
addWithCarry Digit
0## Positive
xs' Positive
ys'

       -- digit `elem` [0, 1]
       addOnCarry :: Digit -> Positive -> Positive
       addOnCarry :: Digit -> Positive -> Positive
addOnCarry (!Digit
c) (!Positive
ws) = if Int# -> Bool
isTrue# (Digit
c Digit -> Digit -> Int#
`eqWord#` Digit
0##)
                               then Positive
ws
                               else Positive -> Positive
succPositive Positive
ws

-- digit `elem` [0, 1]
succPositive :: Positive -> Positive
succPositive :: Positive -> Positive
succPositive Positive
None = Digit -> Positive -> Positive
Some Digit
1## Positive
None
succPositive (Some Digit
w Positive
ws) = if Int# -> Bool
isTrue# (Digit
w Digit -> Digit -> Int#
`eqWord#` () -> Digit
fullBound ())
                           then Digit -> Positive -> Positive
Some Digit
0## (Positive -> Positive
succPositive Positive
ws)
                           else Digit -> Positive -> Positive
Some (Digit
w Digit -> Digit -> Digit
`plusWord#` Digit
1##) Positive
ws

-- Requires x > y
-- In recursive calls, x >= y and x == y => result is None
-- Note [Avoid patError]
minusPositive :: Positive -> Positive -> Positive
Some Digit
x Positive
xs minusPositive :: Positive -> Positive -> Positive
`minusPositive` Some Digit
y Positive
ys
 = if Int# -> Bool
isTrue# (Digit
x Digit -> Digit -> Int#
`eqWord#` Digit
y)
   then case Positive
xs Positive -> Positive -> Positive
`minusPositive` Positive
ys of
        Positive
None -> Positive
None
        Positive
s -> Digit -> Positive -> Positive
Some Digit
0## Positive
s
   else if Int# -> Bool
isTrue# (Digit
x Digit -> Digit -> Int#
`gtWord#` Digit
y) then
        Digit -> Positive -> Positive
Some (Digit
x Digit -> Digit -> Digit
`minusWord#` Digit
y) (Positive
xs Positive -> Positive -> Positive
`minusPositive` Positive
ys)
   else case (() -> Digit
fullBound () Digit -> Digit -> Digit
`minusWord#` Digit
y) Digit -> Digit -> Digit
`plusWord#` Digit
1## of
        Digit
z -> -- z = 2^n - y, calculated without overflow
         case Digit
z Digit -> Digit -> Digit
`plusWord#` Digit
x of
         Digit
z' -> -- z = 2^n + (x - y), calculated without overflow
          Digit -> Positive -> Positive
Some Digit
z' ((Positive
xs Positive -> Positive -> Positive
`minusPositive` Positive
ys) Positive -> Positive -> Positive
`minusPositive` Positive
onePositive)
xs :: Positive
xs@(Some {}) `minusPositive` Positive
None      = Positive
xs
Positive
None         `minusPositive` Positive
None      = Positive
None
Positive
None         `minusPositive` (Some {}) = Positive
errorPositive -- XXX Can't happen
-- XXX None `minusPositive` _ = error "minusPositive: Requirement x > y not met"

-- Note [Avoid patError]
timesPositive :: Positive -> Positive -> Positive
-- XXX None's can't happen here:
Positive
None            timesPositive :: Positive -> Positive -> Positive
`timesPositive` Positive
None        = Positive
errorPositive
Positive
None            `timesPositive` (Some {})   = Positive
errorPositive
(Some {})       `timesPositive` Positive
None        = Positive
errorPositive
-- x and y are the last digits in Positive numbers, so are not 0:
xs :: Positive
xs@(Some Digit
x Positive
xs') `timesPositive` ys :: Positive
ys@(Some Digit
y Positive
ys')
 = case Positive
xs' of
   Positive
None ->
       case Positive
ys' of
           Positive
None ->
               Digit
x Digit -> Digit -> Positive
`timesDigit` Digit
y
           Some {} ->
               Positive
ys Positive -> Positive -> Positive
`timesPositive` Positive
xs
   Some {} ->
       case Positive
ys' of
       Positive
None ->
           -- y is the last digit in a Positive number, so is not 0.
           let zs :: Positive
zs = Digit -> Positive -> Positive
Some Digit
0## (Positive
xs' Positive -> Positive -> Positive
`timesPositive` Positive
ys)
           in -- We could actually skip this test, and everything would
              -- turn out OK. We already play tricks like that in timesPositive.
              if Int# -> Bool
isTrue# (Digit
x Digit -> Digit -> Int#
`eqWord#` Digit
0##)
              then Positive
zs
              else (Digit
x Digit -> Digit -> Positive
`timesDigit` Digit
y) Positive -> Positive -> Positive
`plusPositive` Positive
zs
       Some {} ->
           (Digit -> Positive -> Positive
Some Digit
x Positive
None Positive -> Positive -> Positive
`timesPositive` Positive
ys) Positive -> Positive -> Positive
`plusPositive`
           Digit -> Positive -> Positive
Some Digit
0## (Positive
xs' Positive -> Positive -> Positive
`timesPositive` Positive
ys)

{-
-- Requires arguments /= 0
Suppose we have 2n bits in a Word. Then
    x = 2^n xh + xl
    y = 2^n yh + yl
    x * y = (2^n xh + xl) * (2^n yh + yl)
          = 2^(2n) (xh yh)
          + 2^n    (xh yl)
          + 2^n    (xl yh)
          +        (xl yl)
                   ~~~~~~~ - all fit in 2n bits
-}
timesDigit :: Digit -> Digit -> Positive
timesDigit :: Digit -> Digit -> Positive
timesDigit (!Digit
x) (!Digit
y)
 = case Digit -> (# Digit, Digit #)
splitHalves Digit
x of
   (# Digit
xh, Digit
xl #) ->
    case Digit -> (# Digit, Digit #)
splitHalves Digit
y of
    (# Digit
yh, Digit
yl #) ->
     case Digit
xh Digit -> Digit -> Digit
`timesWord#` Digit
yh of
     Digit
xhyh ->
      case Digit -> (# Digit, Digit #)
splitHalves (Digit
xh Digit -> Digit -> Digit
`timesWord#` Digit
yl) of
      (# Digit
xhylh, Digit
xhyll #) ->
       case Digit
xhyll Digit -> Int# -> Digit
`uncheckedShiftL#` () -> Int#
highHalfShift () of
       Digit
xhyll' ->
        case Digit -> (# Digit, Digit #)
splitHalves (Digit
xl Digit -> Digit -> Digit
`timesWord#` Digit
yh) of
        (# Digit
xlyhh, Digit
xlyhl #) ->
         case Digit
xlyhl Digit -> Int# -> Digit
`uncheckedShiftL#` () -> Int#
highHalfShift () of
         Digit
xlyhl' ->
          case Digit
xl Digit -> Digit -> Digit
`timesWord#` Digit
yl of
          Digit
xlyl ->
           -- Add up all the high word results. As the result fits in
           -- 4n bits this can't overflow.
           case Digit
xhyh Digit -> Digit -> Digit
`plusWord#` Digit
xhylh Digit -> Digit -> Digit
`plusWord#` Digit
xlyhh of
           Digit
high ->
           -- low: xhyll<<n + xlyhl<<n + xlyl
            -- From this point we might make (Some 0 None), but we know
            -- that the final result will be positive and the addition
            -- will work out OK, so everything will work out in the end.
            -- One thing we do need to be careful of is avoiding returning
            -- Some 0 (Some 0 None) + Some n None, as this will result in
            -- Some n (Some 0 None) instead of Some n None.
            let low :: Positive
low = Digit -> Positive -> Positive
Some Digit
xhyll' Positive
None Positive -> Positive -> Positive
`plusPositive`
                      Digit -> Positive -> Positive
Some Digit
xlyhl' Positive
None Positive -> Positive -> Positive
`plusPositive`
                      Digit -> Positive -> Positive
Some Digit
xlyl   Positive
None
            in if Int# -> Bool
isTrue# (Digit
high Digit -> Digit -> Int#
`eqWord#` Digit
0##)
               then Positive
low
               else Digit -> Positive -> Positive
Some Digit
0## (Digit -> Positive -> Positive
Some Digit
high Positive
None) Positive -> Positive -> Positive
`plusPositive` Positive
low

splitHalves :: Digit -> (# {- High -} Digit, {- Low -} Digit #)
splitHalves :: Digit -> (# Digit, Digit #)
splitHalves (!Digit
x) = (# Digit
x Digit -> Int# -> Digit
`uncheckedShiftRL#` () -> Int#
highHalfShift (),
                      Digit
x Digit -> Digit -> Digit
`and#` () -> Digit
lowHalfMask () #)

-- Assumes 0 <= i
shiftLPositive :: Positive -> Int# -> Positive
shiftLPositive :: Positive -> Int# -> Positive
shiftLPositive Positive
p Int#
i
    = if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
>=# WORD_SIZE_IN_BITS#)
      then Positive -> Int# -> Positive
shiftLPositive (Digit -> Positive -> Positive
Some Digit
0## Positive
p) (Int#
i Int# -> Int# -> Int#
-# WORD_SIZE_IN_BITS#)
      else Positive -> Int# -> Positive
smallShiftLPositive Positive
p Int#
i

-- Assumes 0 <= i < WORD_SIZE_IN_BITS#
smallShiftLPositive :: Positive -> Int# -> Positive
smallShiftLPositive :: Positive -> Int# -> Positive
smallShiftLPositive (!Positive
p) Int#
0# = Positive
p
smallShiftLPositive (!Positive
p) (!Int#
i) =
    case WORD_SIZE_IN_BITS# -# i of
    Int#
j -> let f :: Digit -> Positive -> Positive
f Digit
carry Positive
None = if Int# -> Bool
isTrue# (Digit
carry Digit -> Digit -> Int#
`eqWord#` Digit
0##)
                            then Positive
None
                            else Digit -> Positive -> Positive
Some Digit
carry Positive
None
             f Digit
carry (Some Digit
w Positive
ws) = case Digit
w Digit -> Int# -> Digit
`uncheckedShiftRL#` Int#
j of
                                   Digit
carry' ->
                                    case Digit
w Digit -> Int# -> Digit
`uncheckedShiftL#` Int#
i of
                                    Digit
me ->
                                     Digit -> Positive -> Positive
Some (Digit
me Digit -> Digit -> Digit
`or#` Digit
carry) (Digit -> Positive -> Positive
f Digit
carry' Positive
ws)
         in Digit -> Positive -> Positive
f Digit
0## Positive
p

-- Assumes 0 <= i
shiftRPositive :: Positive -> Int# -> Integer
shiftRPositive :: Positive -> Int# -> Integer
shiftRPositive Positive
None Int#
_ = Integer
Naught
shiftRPositive p :: Positive
p@(Some Digit
_ Positive
q) Int#
i
    = if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
>=# WORD_SIZE_IN_BITS#)
      then Positive -> Int# -> Integer
shiftRPositive Positive
q (Int#
i Int# -> Int# -> Int#
-# WORD_SIZE_IN_BITS#)
      else Positive -> Int# -> Integer
smallShiftRPositive Positive
p Int#
i

-- Assumes 0 <= i < WORD_SIZE_IN_BITS#
smallShiftRPositive :: Positive -> Int# -> Integer
smallShiftRPositive :: Positive -> Int# -> Integer
smallShiftRPositive (!Positive
p) (!Int#
i) =
    if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
0#)
    then Positive -> Integer
Positive Positive
p
    else case Positive -> Int# -> Positive
smallShiftLPositive Positive
p (WORD_SIZE_IN_BITS# -# i) of
         Some Digit
_ p' :: Positive
p'@(Some Digit
_ Positive
_) -> Positive -> Integer
Positive Positive
p'
         Positive
_                    -> Integer
Naught

-- Long division
quotRemPositive :: Positive -> Positive -> (# Integer, Integer #)
(!Positive
xs) quotRemPositive :: Positive -> Positive -> (# Integer, Integer #)
`quotRemPositive` (!Positive
ys)
    = case Positive -> (# Positive, Positive #)
f Positive
xs of
      (# Positive
d, Positive
m #) -> (# Positive -> Integer
digitsMaybeZeroToInteger Positive
d,
                       Positive -> Integer
digitsMaybeZeroToInteger Positive
m #)
    where
          subtractors :: Positives
          subtractors :: Positives
subtractors = Int# -> Positives
mkSubtractors (WORD_SIZE_IN_BITS# -# 1#)

          mkSubtractors :: Int# -> Positives
mkSubtractors (!Int#
n) = if Int# -> Bool
isTrue# (Int#
n Int# -> Int# -> Int#
==# Int#
0#)
                               then Positive -> Positives -> Positives
forall a. a -> List a -> List a
Cons Positive
ys Positives
forall a. List a
Nil
                               else Positive -> Positives -> Positives
forall a. a -> List a -> List a
Cons (Positive
ys Positive -> Int# -> Positive
`smallShiftLPositive` Int#
n)
                                         (Int# -> Positives
mkSubtractors (Int#
n Int# -> Int# -> Int#
-# Int#
1#))

          -- The main function. Go the the end of xs, then walk
          -- back trying to divide the number we accumulate by ys.
          f :: Positive -> (# Digits, Digits #)
          f :: Positive -> (# Positive, Positive #)
f Positive
None = (# Positive
None, Positive
None #)
          f (Some Digit
z Positive
zs)
              = case Positive -> (# Positive, Positive #)
f Positive
zs of
                (# Positive
ds, Positive
m #) ->
                    let -- We need to avoid making (Some Zero None) here
                        m' :: Positive
m' = Digit -> Positive -> Positive
some Digit
z Positive
m
                    in case Digit -> Positives -> Positive -> (# Digit, Positive #)
g Digit
0## Positives
subtractors Positive
m' of
                       (# Digit
d, Positive
m'' #) ->
                        (# Digit -> Positive -> Positive
some Digit
d Positive
ds, Positive
m'' #)

          g :: Digit -> Positives -> Digits -> (# Digit, Digits #)
          g :: Digit -> Positives -> Positive -> (# Digit, Positive #)
g (!Digit
d) Positives
Nil             (!Positive
m) = (# Digit
d, Positive
m #)
          g (!Digit
d) (Cons Positive
sub Positives
subs) (!Positive
m)
              = case Digit
d Digit -> Int# -> Digit
`uncheckedShiftL#` Int#
1# of
                Digit
d' ->
                 case Positive
m Positive -> Positive -> Ordering
`comparePositive` Positive
sub of
                 Ordering
LT -> Digit -> Positives -> Positive -> (# Digit, Positive #)
g Digit
d' Positives
subs Positive
m
                 Ordering
_  -> Digit -> Positives -> Positive -> (# Digit, Positive #)
g (Digit
d' Digit -> Digit -> Digit
`plusWord#` Digit
1##)
                         Positives
subs
                         (Positive
m Positive -> Positive -> Positive
`minusPositive` Positive
sub)

some :: Digit -> Digits -> Digits
some :: Digit -> Positive -> Positive
some (!Digit
w) Positive
None  = if Int# -> Bool
isTrue# (Digit
w Digit -> Digit -> Int#
`eqWord#` Digit
0##) then Positive
None else Digit -> Positive -> Positive
Some Digit
w Positive
None
some (!Digit
w) (!Positive
ws) = Digit -> Positive -> Positive
Some Digit
w Positive
ws

-- Note [Avoid patError]
andDigits :: Digits -> Digits -> Digits
andDigits :: Positive -> Positive -> Positive
andDigits Positive
None          Positive
None          = Positive
None
andDigits (Some {})     Positive
None          = Positive
None
andDigits Positive
None          (Some {})     = Positive
None
andDigits (Some Digit
w1 Positive
ws1) (Some Digit
w2 Positive
ws2) = Digit -> Positive -> Positive
Some (Digit
w1 Digit -> Digit -> Digit
`and#` Digit
w2) (Positive -> Positive -> Positive
andDigits Positive
ws1 Positive
ws2)

-- DigitsOnes is just like Digits, only None is really 0xFFFFFFF...,
-- i.e. ones off to infinity. This makes sense when we want to "and"
-- a DigitOnes with a Digits, as the latter will bound the size of the
-- result.
newtype DigitsOnes = DigitsOnes Digits

-- Note [Avoid patError]
andDigitsOnes :: DigitsOnes -> Digits -> Digits
andDigitsOnes :: DigitsOnes -> Positive -> Positive
andDigitsOnes (DigitsOnes Positive
None)          Positive
None          = Positive
None
andDigitsOnes (DigitsOnes Positive
None)          ws2 :: Positive
ws2@(Some {}) = Positive
ws2
andDigitsOnes (DigitsOnes (Some {}))     Positive
None          = Positive
None
andDigitsOnes (DigitsOnes (Some Digit
w1 Positive
ws1)) (Some Digit
w2 Positive
ws2)
    = Digit -> Positive -> Positive
Some (Digit
w1 Digit -> Digit -> Digit
`and#` Digit
w2) (DigitsOnes -> Positive -> Positive
andDigitsOnes (Positive -> DigitsOnes
DigitsOnes Positive
ws1) Positive
ws2)

-- Note [Avoid patError]
orDigits :: Digits -> Digits -> Digits
orDigits :: Positive -> Positive -> Positive
orDigits Positive
None          Positive
None          = Positive
None
orDigits Positive
None          ds :: Positive
ds@(Some {})  = Positive
ds
orDigits ds :: Positive
ds@(Some {})  Positive
None          = Positive
ds
orDigits (Some Digit
w1 Positive
ds1) (Some Digit
w2 Positive
ds2) = Digit -> Positive -> Positive
Some (Digit
w1 Digit -> Digit -> Digit
`or#` Digit
w2) (Positive -> Positive -> Positive
orDigits Positive
ds1 Positive
ds2)

-- Note [Avoid patError]
xorDigits :: Digits -> Digits -> Digits
xorDigits :: Positive -> Positive -> Positive
xorDigits Positive
None          Positive
None          = Positive
None
xorDigits Positive
None          ds :: Positive
ds@(Some {})  = Positive
ds
xorDigits ds :: Positive
ds@(Some {})  Positive
None          = Positive
ds
xorDigits (Some Digit
w1 Positive
ds1) (Some Digit
w2 Positive
ds2) = Digit -> Positive -> Positive
Some (Digit
w1 Digit -> Digit -> Digit
`xor#` Digit
w2) (Positive -> Positive -> Positive
xorDigits Positive
ds1 Positive
ds2)

-- XXX We'd really like word2Double# for this
doubleFromPositive :: Positive -> Double#
doubleFromPositive :: Positive -> Double#
doubleFromPositive Positive
None = Double#
0.0##
doubleFromPositive (Some Digit
w Positive
ds)
    = case Digit -> (# Digit, Digit #)
splitHalves Digit
w of
      (# Digit
h, Digit
l #) ->
       (Positive -> Double#
doubleFromPositive Positive
ds Double# -> Double# -> Double#
*## (Double#
2.0## Double# -> Double# -> Double#
**## WORD_SIZE_IN_BITS_FLOAT##))
       Double# -> Double# -> Double#
+## (Int# -> Double#
int2Double# (Digit -> Int#
word2Int# Digit
h) Double# -> Double# -> Double#
*##
              (Double#
2.0## Double# -> Double# -> Double#
**## Int# -> Double#
int2Double# (() -> Int#
highHalfShift ())))
       Double# -> Double# -> Double#
+## Int# -> Double#
int2Double# (Digit -> Int#
word2Int# Digit
l)

-- XXX We'd really like word2Float# for this
floatFromPositive :: Positive -> Float#
floatFromPositive :: Positive -> Float#
floatFromPositive Positive
None = Float#
0.0#
floatFromPositive (Some Digit
w Positive
ds)
    = case Digit -> (# Digit, Digit #)
splitHalves Digit
w of
      (# Digit
h, Digit
l #) ->
       (Positive -> Float#
floatFromPositive Positive
ds Float# -> Float# -> Float#
`timesFloat#` (Float#
2.0# Float# -> Float# -> Float#
`powerFloat#` WORD_SIZE_IN_BITS_FLOAT#))
       Float# -> Float# -> Float#
`plusFloat#` (Int# -> Float#
int2Float# (Digit -> Int#
word2Int# Digit
h) Float# -> Float# -> Float#
`timesFloat#`
             (Float#
2.0# Float# -> Float# -> Float#
`powerFloat#` Int# -> Float#
int2Float# (() -> Int#
highHalfShift ())))
       Float# -> Float# -> Float#
`plusFloat#` Int# -> Float#
int2Float# (Digit -> Int#
word2Int# Digit
l)

{-
Note [Avoid patError]

If we use the natural set of definitions for functions, e.g.:

    orDigits None          ds            = ds
    orDigits ds            None          = ds
    orDigits (Some w1 ds1) (Some w2 ds2) = Some ... ...

then GHC may not be smart enough (especially when compiling with -O0)
to see that all the cases are handled, and will thus insert calls to
base:Control.Exception.Base.patError. But we are below base in the
package hierarchy, so this causes build failure!

We therefore help GHC out, by being more explicit about what all the
cases are:

    orDigits None          None          = None
    orDigits None          ds@(Some {})  = ds
    orDigits ds@(Some {})  None          = ds
    orDigits (Some w1 ds1) (Some w2 ds2) = Some ... ...
-}