urbit-atom: Vendor integer-simple.

pkg/hs/stack.yaml

@@ -7,6 +7,7 @@ packages:
   - urbit-atom
   - urbit-azimuth
   - urbit-king
+  - urbit-integer-simple
 
 extra-deps:
   - flat-0.3.4@sha256:002a0e0ae656ea8cc02a772d0bcb6ea7dbd7f2e79070959cc748ad1e7138eb38

pkg/hs/urbit-integer-simple/LICENSE

@@ -0,0 +1,26 @@
+Copyright (c) Ian Lynagh, 2007-2008.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of its contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.

pkg/hs/urbit-integer-simple/Setup.hs

@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain

pkg/hs/urbit-integer-simple/Urbit/Integer.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Urbit.Integer
+-- 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 Urbit.Integer (
+    Integer, mkInteger,
+    smallInteger, wordToInteger, integerToWord, integerToInt,
+#if WORD_SIZE_IN_BITS < 64
+    integerToWord64, word64ToInteger,
+    integerToInt64, int64ToInteger,
+#endif
+    plusInteger, minusInteger, timesInteger, negateInteger,
+    eqInteger, neqInteger, absInteger, signumInteger,
+    leInteger, gtInteger, ltInteger, geInteger, compareInteger,
+    eqInteger#, neqInteger#,
+    leInteger#, gtInteger#, ltInteger#, geInteger#,
+    divInteger, modInteger,
+    divModInteger, quotRemInteger, quotInteger, remInteger,
+    encodeFloatInteger, decodeFloatInteger, floatFromInteger,
+    encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
+    -- gcdInteger, lcmInteger, -- XXX
+    andInteger, orInteger, xorInteger, complementInteger,
+    shiftLInteger, shiftRInteger, testBitInteger,
+    hashInteger,
+ ) where
+
+import Urbit.Integer.Type
+

pkg/hs/urbit-integer-simple/Urbit/Integer/Logarithms.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+module Urbit.Integer.Logarithms
+    ( integerLogBase#
+    , integerLog2#
+    , wordLog2#
+    ) where
+
+import GHC.Prim
+import Urbit.Integer
+import qualified Urbit.Integer.Logarithms.Internals as I
+
+-- | Calculate the integer logarithm for an arbitrary base.
+--   The base must be greater than 1, the second argument, the number
+--   whose logarithm is sought, should be positive, otherwise the
+--   result is meaningless.
+--
+-- > base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
+--
+-- for @base > 1@ and @m > 0@.
+integerLogBase# :: Integer -> Integer -> Int#
+integerLogBase# b m = case step b of
+                        (# _, e #) -> e
+  where
+    step pw =
+      if m `ltInteger` pw
+        then (# m, 0# #)
+        else case step (pw `timesInteger` pw) of
+               (# q, e #) ->
+                 if q `ltInteger` pw
+                   then (# q, 2# *# e #)
+                   else (# q `quotInteger` pw, 2# *# e +# 1# #)
+
+-- | Calculate the integer base 2 logarithm of an 'Integer'.
+--   The calculation is more efficient than for the general case,
+--   on platforms with 32- or 64-bit words much more efficient.
+--
+--  The argument must be strictly positive, that condition is /not/ checked.
+integerLog2# :: Integer -> Int#
+integerLog2# = I.integerLog2#
+
+-- | This function calculates the integer base 2 logarithm of a 'Word#'.
+wordLog2# :: Word# -> Int#
+wordLog2# = I.wordLog2#

pkg/hs/urbit-integer-simple/Urbit/Integer/Logarithms/Internals.hs

@@ -0,0 +1,166 @@
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+#include "MachDeps.h"
+
+-- (Hopefully) Fast integer logarithms to base 2.
+-- integerLog2# and wordLog2# are of general usefulness,
+-- the others are only needed for a fast implementation of
+-- fromRational.
+-- Since they are needed in Urbit.Float, we must expose this
+-- module, but it should not show up in the docs.
+
+module Urbit.Integer.Logarithms.Internals
+    ( integerLog2#
+    , integerLog2IsPowerOf2#
+    , wordLog2#
+    , roundingMode#
+    ) where
+
+import GHC.Prim
+import Urbit.Integer.Type
+import GHC.Types
+
+default ()
+
+-- When larger word sizes become common, add support for those,
+-- it's not hard, just tedious.
+#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)
+
+-- We don't know whether the word has 30 bits or 128 or even more,
+-- so we can't start from the top, although that would be much more
+-- efficient.
+wordLog2# :: Word# -> Int#
+wordLog2# w = go 8# w
+  where
+    go acc u = case u `uncheckedShiftRL#` 8# of
+                0## -> case leadingZeros of
+                        BA ba -> acc -# indexInt8Array# ba (word2Int# u)
+                v   -> go (acc +# 8#) v
+
+#else
+
+-- This one at least can also be done efficiently.
+-- wordLog2# 0## = -1#
+{-# INLINE wordLog2# #-}
+wordLog2# :: Word# -> Int#
+wordLog2# w =
+  case leadingZeros of
+   BA lz ->
+    let zeros u = indexInt8Array# lz (word2Int# u) in
+#if WORD_SIZE_IN_BITS == 64
+    case uncheckedShiftRL# w 56# of
+     a ->
+      if isTrue# (a `neWord#` 0##)
+       then 64# -# zeros a
+       else
+        case uncheckedShiftRL# w 48# of
+         b ->
+          if isTrue# (b `neWord#` 0##)
+           then 56# -# zeros b
+           else
+            case uncheckedShiftRL# w 40# of
+             c ->
+              if isTrue# (c `neWord#` 0##)
+               then 48# -# zeros c
+               else
+                case uncheckedShiftRL# w 32# of
+                 d ->
+                  if isTrue# (d `neWord#` 0##)
+                   then 40# -# zeros d
+                   else
+#endif
+                    case uncheckedShiftRL# w 24# of
+                     e ->
+                      if isTrue# (e `neWord#` 0##)
+                       then 32# -# zeros e
+                       else
+                        case uncheckedShiftRL# w 16# of
+                         f ->
+                          if isTrue# (f `neWord#` 0##)
+                           then 24# -# zeros f
+                           else
+                            case uncheckedShiftRL# w 8# of
+                             g ->
+                              if isTrue# (g `neWord#` 0##)
+                               then 16# -# zeros g
+                               else  8# -# zeros w
+
+#endif
+
+-- Assumption: Integer is strictly positive,
+-- otherwise return -1# arbitrarily
+-- Going up in word-sized steps should not be too bad.
+integerLog2# :: Integer -> Int#
+integerLog2# (Positive digits) = step 0# digits
+  where
+    step acc (Some dig None) = acc +# wordLog2# dig
+    step acc (Some _ digs)   =
+        step (acc +# WORD_SIZE_IN_BITS#) digs
+    step acc None = acc     -- should be impossible, throw error?
+integerLog2# _ = negateInt# 1#
+
+-- Again, integer should be strictly positive
+integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
+integerLog2IsPowerOf2# (Positive digits) = couldBe 0# digits
+  where
+    couldBe acc (Some dig None) =
+        (# acc +# wordLog2# dig, word2Int# (and# dig (minusWord# dig 1##)) #)
+    couldBe acc (Some dig digs) =
+        if isTrue# (eqWord# dig 0##)
+           then couldBe (acc +# WORD_SIZE_IN_BITS#) digs
+           else noPower (acc +# WORD_SIZE_IN_BITS#) digs
+    couldBe acc None = (# acc, 1# #) -- should be impossible, error?
+    noPower acc (Some dig None) =
+        (# acc +# wordLog2# dig, 1# #)
+    noPower acc (Some _ digs)   =
+        noPower (acc +# WORD_SIZE_IN_BITS#) digs
+    noPower acc None = (# acc, 1# #) -- should be impossible, error?
+integerLog2IsPowerOf2# _ = (# negateInt# 1#, 1# #)
+
+-- Assumption: Integer and Int# are strictly positive, Int# is less
+-- than logBase 2 of Integer, otherwise havoc ensues.
+-- Used only for the numerator in fromRational when the denominator
+-- is a power of 2.
+-- The Int# argument is log2 n minus the number of bits in the mantissa
+-- of the target type, i.e. the index of the first non-integral bit in
+-- the quotient.
+--
+-- 0# means round down (towards zero)
+-- 1# means we have a half-integer, round to even
+-- 2# means round up (away from zero)
+-- This function should probably be improved.
+roundingMode# :: Integer -> Int# -> Int#
+roundingMode# m h =
+    case oneInteger `shiftLInteger` h of
+      c -> case m `andInteger`
+                ((c `plusInteger` c) `minusInteger` oneInteger) of
+             r ->
+               if c `ltInteger` r
+                 then 2#
+                 else if c `gtInteger` r
+                        then 0#
+                        else 1#
+
+-- Lookup table
+data BA = BA ByteArray#
+
+leadingZeros :: BA
+leadingZeros =
+    let mkArr s =
+          case newByteArray# 256# s of
+            (# s1, mba #) ->
+              case writeInt8Array# mba 0# 9# s1 of
+                s2 ->
+                  let fillA lim val idx st =
+                        if isTrue# (idx ==# 256#)
+                          then st
+                          else if isTrue# (idx <# lim)
+                                then case writeInt8Array# mba idx val st of
+                                        nx -> fillA lim val (idx +# 1#) nx
+                                else fillA (2# *# lim) (val -# 1#) idx st
+                  in case fillA 2# 8# 1# s2 of
+                      s3 -> case unsafeFreezeByteArray# mba s3 of
+                              (# _, ba #) -> ba
+    in case mkArr realWorld# of
+        b -> BA b

pkg/hs/urbit-integer-simple/Urbit/Integer/Simple/Internals.hs

@@ -0,0 +1,23 @@
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Urbit.Integer.Simple.Internals
+-- Copyright   :  (c) Ian Lynagh 2007-2008
+-- License     :  BSD3
+--
+-- Maintainer  :  igloo@earth.li
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- An simple definition of the 'Integer' type.
+--
+-----------------------------------------------------------------------------
+
+module Urbit.Integer.Simple.Internals (
+    module Urbit.Integer.Type
+ ) where
+
+import Urbit.Integer.Type
+

pkg/hs/urbit-integer-simple/Urbit/Integer/Type.hs

@@ -0,0 +1,891 @@
+
+{-# 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      :  Urbit.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 Urbit.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 nonNegative is = let abs = f is
+                           in if nonNegative then abs else negateInteger abs
+    where f [] = Naught
+          f (I# i : is') = smallInteger i `orInteger` shiftLInteger (f is') 31#
+
+errorInteger :: Integer
+errorInteger = Positive errorPositive
+
+errorPositive :: Positive
+errorPositive = Some 47## None -- Random number
+
+{-# NOINLINE smallInteger #-}
+smallInteger :: Int# -> Integer
+smallInteger i = if isTrue# (i >=# 0#) then wordToInteger (int2Word# i)
+                 else -- XXX is this right for -minBound?
+                      negateInteger (wordToInteger (int2Word# (negateInt# i)))
+
+{-# NOINLINE wordToInteger #-}
+wordToInteger :: Word# -> Integer
+wordToInteger w = if isTrue# (w `eqWord#` 0##)
+                  then Naught
+                  else Positive (Some w None)
+
+{-# NOINLINE integerToWord #-}
+integerToWord :: Integer -> Word#
+integerToWord (Positive (Some w _)) = w
+integerToWord (Negative (Some w _)) = 0## `minusWord#` w
+-- Must be Naught by the invariant:
+integerToWord _ = 0##
+
+{-# NOINLINE integerToInt #-}
+integerToInt :: Integer -> Int#
+integerToInt i = word2Int# (integerToWord 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 = Positive onePositive
+
+negativeOneInteger :: Integer
+negativeOneInteger = Negative onePositive
+
+twoToTheThirtytwoInteger :: Integer
+twoToTheThirtytwoInteger = Positive twoToTheThirtytwoPositive
+
+{-# NOINLINE encodeDoubleInteger #-}
+encodeDoubleInteger :: Integer -> Int# -> Double#
+encodeDoubleInteger (Positive ds0) e0 = f 0.0## ds0 e0
+    where f !acc None        (!_) = acc
+          f !acc (Some d ds) !e   = f (acc +## encodeDouble# d e)
+                                      ds
+                                      -- XXX We assume that this adding to e
+                                      -- isn't going to overflow
+                                      (e +# WORD_SIZE_IN_BITS#)
+encodeDoubleInteger (Negative ds) e
+    = negateDouble# (encodeDoubleInteger (Positive ds) e)
+encodeDoubleInteger Naught _ = 0.0##
+
+foreign import ccall unsafe "__word_encodeDouble"
+        encodeDouble# :: Word# -> Int# -> Double#
+
+{-# NOINLINE encodeFloatInteger #-}
+encodeFloatInteger :: Integer -> Int# -> Float#
+encodeFloatInteger (Positive ds0) e0 = f 0.0# ds0 e0
+    where f !acc None        (!_) = acc
+          f !acc (Some d ds) !e   = f (acc `plusFloat#` encodeFloat# d e)
+                                      ds
+                                      -- XXX We assume that this adding to e
+                                      -- isn't going to overflow
+                                      (e +# WORD_SIZE_IN_BITS#)
+encodeFloatInteger (Negative ds) e
+    = negateFloat# (encodeFloatInteger (Positive ds) e)
+encodeFloatInteger Naught _ = 0.0#
+
+foreign import ccall unsafe "__word_encodeFloat"
+    encodeFloat# :: Word# -> Int# -> Float#
+
+{-# NOINLINE decodeFloatInteger #-}
+decodeFloatInteger :: Float# -> (# Integer, Int# #)
+decodeFloatInteger f = case decodeFloat_Int# f of
+                       (# mant, exp #) -> (# smallInteger mant, 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 d
+ = case decodeDouble_2Int# d of
+   (# mantSign, mantHigh, mantLow, exp #) ->
+       (# (smallInteger mantSign) `timesInteger`
+          (  (wordToInteger mantHigh `timesInteger` twoToTheThirtytwoInteger)
+             `plusInteger` wordToInteger mantLow),
+          exp #)
+
+{-# NOINLINE doubleFromInteger #-}
+doubleFromInteger :: Integer -> Double#
+doubleFromInteger Naught = 0.0##
+doubleFromInteger (Positive p) = doubleFromPositive p
+doubleFromInteger (Negative p) = negateDouble# (doubleFromPositive p)
+
+{-# NOINLINE floatFromInteger #-}
+floatFromInteger :: Integer -> Float#
+floatFromInteger Naught = 0.0#
+floatFromInteger (Positive p) = floatFromPositive p
+floatFromInteger (Negative p) = negateFloat# (floatFromPositive p)
+
+{-# NOINLINE andInteger #-}
+andInteger :: Integer -> Integer -> Integer
+Naught     `andInteger` (!_)       = Naught
+(!_)       `andInteger` Naught     = Naught
+Positive x `andInteger` Positive y = digitsToInteger (x `andDigits` 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 x `andInteger` Negative y = let y' = twosComplementPositive y
+                                         z = y' `andDigitsOnes` x
+                                     in digitsToInteger z
+Negative x `andInteger` Positive y = Positive y `andInteger` Negative 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 x `andInteger` Negative y = let x' = x `minusPositive` onePositive
+                                         y' = y `minusPositive` onePositive
+                                         z = x' `orDigits` y'
+                                         -- XXX Cheating the precondition:
+                                         z' = succPositive z
+                                     in digitsToNegativeInteger z'
+
+{-# NOINLINE orInteger #-}
+orInteger :: Integer -> Integer -> Integer
+Naught     `orInteger` (!i)       = i
+(!i)       `orInteger` Naught     = i
+Positive x `orInteger` Positive y = Positive (x `orDigits` y)
+{-
+x | -y = - (twosComplement (x | twosComplement y))
+       = - (twosComplement !(!x & !(twosComplement y)))
+       = - (twosComplement !(!x & !(!y + 1)))
+       = - (twosComplement !(!x & (y - 1)))
+       = - ((!x & (y - 1)) + 1)
+-}
+Positive x `orInteger` Negative y = let x' = flipBits x
+                                        y' = y `minusPositive` onePositive
+                                        z = x' `andDigitsOnes` y'
+                                        z' = succPositive z
+                                    in digitsToNegativeInteger z'
+Negative x `orInteger` Positive y = Positive y `orInteger` Negative 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 x `orInteger` Negative y = let x' = x `minusPositive` onePositive
+                                        y' = y `minusPositive` onePositive
+                                        z = x' `andDigits` y'
+                                        z' = succPositive z
+                                    in digitsToNegativeInteger z'
+
+{-# NOINLINE xorInteger #-}
+xorInteger :: Integer -> Integer -> Integer
+Naught     `xorInteger` (!i)       = i
+(!i)       `xorInteger` Naught     = i
+Positive x `xorInteger` Positive y = digitsToInteger (x `xorDigits` y)
+{-
+x ^ -y = - (twosComplement (x ^ twosComplement y))
+       = - (twosComplement !(x ^ !(twosComplement y)))
+       = - (twosComplement !(x ^ !(!y + 1)))
+       = - (twosComplement !(x ^ (y - 1)))
+       = - ((x ^ (y - 1)) + 1)
+-}
+Positive x `xorInteger` Negative y = let y' = y `minusPositive` onePositive
+                                         z = x `xorDigits` y'
+                                         z' = succPositive z
+                                     in digitsToNegativeInteger z'
+Negative x `xorInteger` Positive y = Positive y `xorInteger` Negative x
+{-
+-x ^ -y = twosComplement x ^ twosComplement y
+        = (!x + 1) ^ (!y + 1)
+        = (!x + 1) ^ (!y + 1)
+        = !(!x + 1) ^ !(!y + 1)
+        = (x - 1) ^ (y - 1)
+-}
+Negative x `xorInteger` Negative y = let x' = x `minusPositive` onePositive
+                                         y' = y `minusPositive` onePositive
+                                         z = x' `xorDigits` y'
+                                     in digitsToInteger z
+
+{-# NOINLINE complementInteger #-}
+complementInteger :: Integer -> Integer
+complementInteger x = negativeOneInteger `minusInteger` x
+
+{-# NOINLINE shiftLInteger #-}
+shiftLInteger :: Integer -> Int# -> Integer
+shiftLInteger (Positive p) i = Positive (shiftLPositive p i)
+shiftLInteger (Negative n) i = Negative (shiftLPositive n i)
+shiftLInteger Naught       _ = Naught
+
+{-# NOINLINE shiftRInteger #-}
+shiftRInteger :: Integer -> Int# -> Integer
+shiftRInteger (Positive p)   i = shiftRPositive p i
+shiftRInteger j@(Negative _) i
+    = complementInteger (shiftRInteger (complementInteger j) i)
+shiftRInteger Naught         _ = 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 x i = (x `andInteger` (oneInteger `shiftLInteger` i))
+        `neqInteger` Naught
+
+twosComplementPositive :: Positive -> DigitsOnes
+twosComplementPositive p = flipBits (p `minusPositive` onePositive)
+
+flipBits :: Digits -> DigitsOnes
+flipBits ds = DigitsOnes (flipBitsDigits ds)
+
+flipBitsDigits :: Digits -> Digits
+flipBitsDigits None = None
+flipBitsDigits (Some w ws) = Some (not# w) (flipBitsDigits ws)
+
+{-# NOINLINE negateInteger #-}
+negateInteger :: Integer -> Integer
+negateInteger (Positive p) = Negative p
+negateInteger (Negative p) = Positive p
+negateInteger Naught       = Naught
+
+-- Note [Avoid patError]
+{-# NOINLINE plusInteger #-}
+plusInteger :: Integer -> Integer -> Integer
+Positive p1    `plusInteger` Positive p2 = Positive (p1 `plusPositive` p2)
+Negative p1    `plusInteger` Negative p2 = Negative (p1 `plusPositive` p2)
+Positive p1    `plusInteger` Negative p2
+    = case p1 `comparePositive` p2 of
+      GT -> Positive (p1 `minusPositive` p2)
+      EQ -> Naught
+      LT -> Negative (p2 `minusPositive` p1)
+Negative p1    `plusInteger` Positive p2
+    = Positive p2 `plusInteger` Negative p1
+Naught         `plusInteger` Naught         = Naught
+Naught         `plusInteger` i@(Positive _) = i
+Naught         `plusInteger` i@(Negative _) = i
+i@(Positive _) `plusInteger` Naught         = i
+i@(Negative _) `plusInteger` Naught         = i
+
+{-# NOINLINE minusInteger #-}
+minusInteger :: Integer -> Integer -> Integer
+i1 `minusInteger` i2 = i1 `plusInteger` negateInteger i2
+
+{-# NOINLINE timesInteger #-}
+timesInteger :: Integer -> Integer -> Integer
+Positive p1 `timesInteger` Positive p2 = Positive (p1 `timesPositive` p2)
+Negative p1 `timesInteger` Negative p2 = Positive (p1 `timesPositive` p2)
+Positive p1 `timesInteger` Negative p2 = Negative (p1 `timesPositive` p2)
+Negative p1 `timesInteger` Positive p2 = Negative (p1 `timesPositive` p2)
+(!_)        `timesInteger` (!_)        = Naught
+
+{-# NOINLINE divModInteger #-}
+divModInteger :: Integer -> Integer -> (# Integer, Integer #)
+n `divModInteger` d =
+    case n `quotRemInteger` d of
+        (# q, r #) ->
+            if signumInteger r `eqInteger`
+               negateInteger (signumInteger d)
+            then (# q `minusInteger` oneInteger, r `plusInteger` d #)
+            else (# q, r #)
+
+{-# NOINLINE divInteger #-}
+divInteger :: Integer -> Integer -> Integer
+n `divInteger` d = quotient
+    where (# quotient, _ #) = n `divModInteger` d
+
+{-# NOINLINE modInteger #-}
+modInteger :: Integer -> Integer -> Integer
+n `modInteger` d = modulus
+    where (# _, modulus #) = n `divModInteger` d
+
+{-# NOINLINE quotRemInteger #-}
+quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
+Naught      `quotRemInteger` (!_)        = (# Naught, Naught #)
+(!_)        `quotRemInteger` Naught
+    = (# errorInteger, errorInteger #) -- XXX Can't happen
+-- XXX _            `quotRemInteger` Naught     = error "Division by zero"
+Positive p1 `quotRemInteger` Positive p2 = p1 `quotRemPositive` p2
+Negative p1 `quotRemInteger` Positive p2 = case p1 `quotRemPositive` p2 of
+                                           (# q, r #) ->
+                                               (# negateInteger q,
+                                                  negateInteger r #)
+Positive p1 `quotRemInteger` Negative p2 = case p1 `quotRemPositive` p2 of
+                                           (# q, r #) ->
+                                               (# negateInteger q, r #)
+Negative p1 `quotRemInteger` Negative p2 = case p1 `quotRemPositive` p2 of
+                                           (# q, r #) ->
+                                               (# q, negateInteger r #)
+
+{-# NOINLINE quotInteger #-}
+quotInteger :: Integer -> Integer -> Integer
+x `quotInteger` y = case x `quotRemInteger` y of
+                    (# q, _ #) -> q
+
+{-# NOINLINE remInteger #-}
+remInteger :: Integer -> Integer -> Integer
+x `remInteger` y = case x `quotRemInteger` y of
+                   (# _, r #) -> r
+
+{-# NOINLINE compareInteger #-}
+compareInteger :: Integer -> Integer -> Ordering
+Positive x `compareInteger` Positive y = x `comparePositive` y
+Positive _ `compareInteger` (!_)       = GT
+Naught     `compareInteger` Naught     = EQ
+Naught     `compareInteger` Negative _ = GT
+Negative x `compareInteger` Negative y = y `comparePositive` x
+(!_)       `compareInteger` (!_)       = LT
+
+{-# NOINLINE eqInteger# #-}
+eqInteger# :: Integer -> Integer -> Int#
+x `eqInteger#` y = case x `compareInteger` y of
+                        EQ -> 1#
+                        _  -> 0#
+
+{-# NOINLINE neqInteger# #-}
+neqInteger# :: Integer -> Integer -> Int#
+x `neqInteger#` y = case x `compareInteger` y of
+                         EQ -> 0#
+                         _  -> 1#
+
+{-# INLINE eqInteger  #-}
+{-# INLINE neqInteger #-}
+eqInteger, neqInteger :: Integer -> Integer -> Bool
+eqInteger  a b = isTrue# (a `eqInteger#`  b)
+neqInteger a b = isTrue# (a `neqInteger#` b)
+
+instance  Eq Integer  where
+    (==) = eqInteger
+    (/=) = neqInteger
+
+{-# NOINLINE ltInteger# #-}
+ltInteger# :: Integer -> Integer -> Int#
+x `ltInteger#` y = case x `compareInteger` y of
+                        LT -> 1#
+                        _  -> 0#
+
+{-# NOINLINE gtInteger# #-}
+gtInteger# :: Integer -> Integer -> Int#
+x `gtInteger#` y = case x `compareInteger` y of
+                        GT -> 1#
+                        _  -> 0#
+
+{-# NOINLINE leInteger# #-}
+leInteger# :: Integer -> Integer -> Int#
+x `leInteger#` y = case x `compareInteger` y of
+                        GT -> 0#
+                        _  -> 1#
+
+{-# NOINLINE geInteger# #-}
+geInteger# :: Integer -> Integer -> Int#
+x `geInteger#` y = case x `compareInteger` y of
+                        LT -> 0#
+                        _  -> 1#
+
+{-# INLINE leInteger #-}
+{-# INLINE ltInteger #-}
+{-# INLINE geInteger #-}
+{-# INLINE gtInteger #-}
+leInteger, gtInteger, ltInteger, geInteger :: Integer -> Integer -> Bool
+leInteger a b = isTrue# (a `leInteger#` b)
+gtInteger a b = isTrue# (a `gtInteger#` b)
+ltInteger a b = isTrue# (a `ltInteger#` b)
+geInteger a b = isTrue# (a `geInteger#` b)
+
+instance Ord Integer where
+    (<=) = leInteger
+    (>)  = gtInteger
+    (<)  = ltInteger
+    (>=) = geInteger
+    compare = compareInteger
+
+{-# NOINLINE absInteger #-}
+absInteger :: Integer -> Integer
+absInteger (Negative x) = Positive x
+absInteger x = x
+
+{-# NOINLINE signumInteger #-}
+signumInteger :: Integer -> Integer
+signumInteger (Negative _) = negativeOneInteger
+signumInteger Naught       = Naught
+signumInteger (Positive _) = oneInteger
+
+{-# NOINLINE hashInteger #-}
+hashInteger :: Integer -> Int#
+hashInteger = integerToInt
+
+-------------------------------------------------------------------
+-- The hard work is done on positive numbers
+
+onePositive :: Positive
+onePositive = Some 1## None
+
+halfBoundUp, fullBound :: () -> Digit
+lowHalfMask :: () -> Digit
+highHalfShift :: () -> Int#
+twoToTheThirtytwoPositive :: Positive
+#if WORD_SIZE_IN_BITS == 64
+halfBoundUp   () = 0x8000000000000000##
+fullBound     () = 0xFFFFFFFFFFFFFFFF##
+lowHalfMask   () = 0xFFFFFFFF##
+highHalfShift () = 32#
+twoToTheThirtytwoPositive = Some 0x100000000## 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 None = Naught
+digitsMaybeZeroToInteger ds = Positive ds
+
+digitsToInteger :: Digits -> Integer
+digitsToInteger ds = case removeZeroTails ds of
+                     None -> Naught
+                     ds' -> Positive ds'
+
+digitsToNegativeInteger :: Digits -> Integer
+digitsToNegativeInteger ds = case removeZeroTails ds of
+                             None -> Naught
+                             ds' -> Negative ds'
+
+removeZeroTails :: Digits -> Digits
+removeZeroTails (Some w ds) = if isTrue# (w `eqWord#` 0##)
+                              then case removeZeroTails ds of
+                                   None -> None
+                                   ds' -> Some w ds'
+                              else Some w (removeZeroTails ds)
+removeZeroTails None = 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 x xs `comparePositive` Some y ys = case xs `comparePositive` ys of
+                                        EQ ->      if isTrue# (x `ltWord#` y) then LT
+                                              else if isTrue# (x `gtWord#` y) then GT
+                                              else                                 EQ
+                                        res -> res
+None      `comparePositive` None      = EQ
+(Some {}) `comparePositive` None      = GT
+None      `comparePositive` (Some {}) = LT
+
+plusPositive :: Positive -> Positive -> Positive
+plusPositive x0 y0 = addWithCarry 0## x0 y0
+ where -- digit `elem` [0, 1]
+       -- Note [Avoid patError]
+       addWithCarry :: Digit -> Positive -> Positive -> Positive
+       addWithCarry c None            None            = addOnCarry c None
+       addWithCarry c xs@(Some {})    None            = addOnCarry c xs
+       addWithCarry c None            ys@(Some {})    = addOnCarry c ys
+       addWithCarry c xs@(Some x xs') ys@(Some y ys')
+        = if isTrue# (x `ltWord#` y) then addWithCarry c ys xs
+          -- Now x >= y
+          else if isTrue# (y `geWord#` halfBoundUp ())
+               -- So they are both at least halfBoundUp, so we subtract
+               -- halfBoundUp from each and thus carry 1
+               then case x `minusWord#` halfBoundUp () of
+                    x' ->
+                     case y `minusWord#` halfBoundUp () of
+                     y' ->
+                      case x' `plusWord#` y' `plusWord#` c of
+                      this ->
+                       Some this withCarry
+          else if isTrue# (x `geWord#` halfBoundUp ())
+               then case x `minusWord#` halfBoundUp () of
+                    x' ->
+                     case x' `plusWord#` y `plusWord#` c of
+                     z ->
+                      -- We've taken off halfBoundUp, so now we need to
+                      -- add it back on
+                      if isTrue# (z `ltWord#` halfBoundUp ())
+                       then Some (z `plusWord#`  halfBoundUp ()) withoutCarry
+                       else Some (z `minusWord#` halfBoundUp ()) withCarry
+          else Some (x `plusWord#` y `plusWord#` c) withoutCarry
+           where withCarry    = addWithCarry 1## xs' ys'
+                 withoutCarry = addWithCarry 0## xs' ys'
+
+       -- digit `elem` [0, 1]
+       addOnCarry :: Digit -> Positive -> Positive
+       addOnCarry (!c) (!ws) = if isTrue# (c `eqWord#` 0##)
+                               then ws
+                               else succPositive ws
+
+-- digit `elem` [0, 1]
+succPositive :: Positive -> Positive
+succPositive None = Some 1## None
+succPositive (Some w ws) = if isTrue# (w `eqWord#` fullBound ())
+                           then Some 0## (succPositive ws)
+                           else Some (w `plusWord#` 1##) ws
+
+-- Requires x > y
+-- In recursive calls, x >= y and x == y => result is None
+-- Note [Avoid patError]
+minusPositive :: Positive -> Positive -> Positive
+Some x xs `minusPositive` Some y ys
+ = if isTrue# (x `eqWord#` y)
+   then case xs `minusPositive` ys of
+        None -> None
+        s -> Some 0## s
+   else if isTrue# (x `gtWord#` y) then
+        Some (x `minusWord#` y) (xs `minusPositive` ys)
+   else case (fullBound () `minusWord#` y) `plusWord#` 1## of
+        z -> -- z = 2^n - y, calculated without overflow
+         case z `plusWord#` x of
+         z' -> -- z = 2^n + (x - y), calculated without overflow
+          Some z' ((xs `minusPositive` ys) `minusPositive` onePositive)
+xs@(Some {}) `minusPositive` None      = xs
+None         `minusPositive` None      = None
+None         `minusPositive` (Some {}) = 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:
+None            `timesPositive` None        = errorPositive
+None            `timesPositive` (Some {})   = errorPositive
+(Some {})       `timesPositive` None        = errorPositive
+-- x and y are the last digits in Positive numbers, so are not 0:
+xs@(Some x xs') `timesPositive` ys@(Some y ys')
+ = case xs' of
+   None ->
+       case ys' of
+           None ->
+               x `timesDigit` y
+           Some {} ->
+               ys `timesPositive` xs
+   Some {} ->
+       case ys' of
+       None ->
+           -- y is the last digit in a Positive number, so is not 0.
+           let zs = Some 0## (xs' `timesPositive` ys)
+           in -- We could actually skip this test, and everything would
+              -- turn out OK. We already play tricks like that in timesPositive.
+              if isTrue# (x `eqWord#` 0##)
+              then zs
+              else (x `timesDigit` y) `plusPositive` zs
+       Some {} ->
+           (Some x None `timesPositive` ys) `plusPositive`
+           Some 0## (xs' `timesPositive` 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 (!x) (!y)
+ = case splitHalves x of
+   (# xh, xl #) ->
+    case splitHalves y of
+    (# yh, yl #) ->
+     case xh `timesWord#` yh of
+     xhyh ->
+      case splitHalves (xh `timesWord#` yl) of
+      (# xhylh, xhyll #) ->
+       case xhyll `uncheckedShiftL#` highHalfShift () of
+       xhyll' ->
+        case splitHalves (xl `timesWord#` yh) of
+        (# xlyhh, xlyhl #) ->
+         case xlyhl `uncheckedShiftL#` highHalfShift () of
+         xlyhl' ->
+          case xl `timesWord#` yl of
+          xlyl ->
+           -- Add up all the high word results. As the result fits in
+           -- 4n bits this can't overflow.
+           case xhyh `plusWord#` xhylh `plusWord#` xlyhh of
+           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 = Some xhyll' None `plusPositive`
+                      Some xlyhl' None `plusPositive`
+                      Some xlyl   None
+            in if isTrue# (high `eqWord#` 0##)
+               then low
+               else Some 0## (Some high None) `plusPositive` low
+
+splitHalves :: Digit -> (# {- High -} Digit, {- Low -} Digit #)
+splitHalves (!x) = (# x `uncheckedShiftRL#` highHalfShift (),
+                      x `and#` lowHalfMask () #)
+
+-- Assumes 0 <= i
+shiftLPositive :: Positive -> Int# -> Positive
+shiftLPositive p i
+    = if isTrue# (i >=# WORD_SIZE_IN_BITS#)
+      then shiftLPositive (Some 0## p) (i -# WORD_SIZE_IN_BITS#)
+      else smallShiftLPositive p i
+
+-- Assumes 0 <= i < WORD_SIZE_IN_BITS#
+smallShiftLPositive :: Positive -> Int# -> Positive
+smallShiftLPositive (!p) 0# = p
+smallShiftLPositive (!p) (!i) =
+    case WORD_SIZE_IN_BITS# -# i of
+    j -> let f carry None = if isTrue# (carry `eqWord#` 0##)
+                            then None
+                            else Some carry None
+             f carry (Some w ws) = case w `uncheckedShiftRL#` j of
+                                   carry' ->
+                                    case w `uncheckedShiftL#` i of
+                                    me ->
+                                     Some (me `or#` carry) (f carry' ws)
+         in f 0## p
+
+-- Assumes 0 <= i
+shiftRPositive :: Positive -> Int# -> Integer
+shiftRPositive None _ = Naught
+shiftRPositive p@(Some _ q) i
+    = if isTrue# (i >=# WORD_SIZE_IN_BITS#)
+      then shiftRPositive q (i -# WORD_SIZE_IN_BITS#)
+      else smallShiftRPositive p i
+
+-- Assumes 0 <= i < WORD_SIZE_IN_BITS#
+smallShiftRPositive :: Positive -> Int# -> Integer
+smallShiftRPositive (!p) (!i) =
+    if isTrue# (i ==# 0#)
+    then Positive p
+    else case smallShiftLPositive p (WORD_SIZE_IN_BITS# -# i) of
+         Some _ p'@(Some _ _) -> Positive p'
+         _                    -> Naught
+
+-- Long division
+quotRemPositive :: Positive -> Positive -> (# Integer, Integer #)
+(!xs) `quotRemPositive` (!ys)
+    = case f xs of
+      (# d, m #) -> (# digitsMaybeZeroToInteger d,
+                       digitsMaybeZeroToInteger m #)
+    where
+          subtractors :: Positives
+          subtractors = mkSubtractors (WORD_SIZE_IN_BITS# -# 1#)
+
+          mkSubtractors (!n) = if isTrue# (n ==# 0#)
+                               then Cons ys Nil
+                               else Cons (ys `smallShiftLPositive` n)
+                                         (mkSubtractors (n -# 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 None = (# None, None #)
+          f (Some z zs)
+              = case f zs of
+                (# ds, m #) ->
+                    let -- We need to avoid making (Some Zero None) here
+                        m' = some z m
+                    in case g 0## subtractors m' of
+                       (# d, m'' #) ->
+                        (# some d ds, m'' #)
+
+          g :: Digit -> Positives -> Digits -> (# Digit, Digits #)
+          g (!d) Nil             (!m) = (# d, m #)
+          g (!d) (Cons sub subs) (!m)
+              = case d `uncheckedShiftL#` 1# of
+                d' ->
+                 case m `comparePositive` sub of
+                 LT -> g d' subs m
+                 _  -> g (d' `plusWord#` 1##)
+                         subs
+                         (m `minusPositive` sub)
+
+some :: Digit -> Digits -> Digits
+some (!w) None  = if isTrue# (w `eqWord#` 0##) then None else Some w None
+some (!w) (!ws) = Some w ws
+
+-- Note [Avoid patError]
+andDigits :: Digits -> Digits -> Digits
+andDigits None          None          = None
+andDigits (Some {})     None          = None
+andDigits None          (Some {})     = None
+andDigits (Some w1 ws1) (Some w2 ws2) = Some (w1 `and#` w2) (andDigits ws1 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 None)          None          = None
+andDigitsOnes (DigitsOnes None)          ws2@(Some {}) = ws2
+andDigitsOnes (DigitsOnes (Some {}))     None          = None
+andDigitsOnes (DigitsOnes (Some w1 ws1)) (Some w2 ws2)
+    = Some (w1 `and#` w2) (andDigitsOnes (DigitsOnes ws1) ws2)
+
+-- Note [Avoid patError]
+orDigits :: Digits -> Digits -> Digits
+orDigits None          None          = None
+orDigits None          ds@(Some {})  = ds
+orDigits ds@(Some {})  None          = ds
+orDigits (Some w1 ds1) (Some w2 ds2) = Some (w1 `or#` w2) (orDigits ds1 ds2)
+
+-- Note [Avoid patError]
+xorDigits :: Digits -> Digits -> Digits
+xorDigits None          None          = None
+xorDigits None          ds@(Some {})  = ds
+xorDigits ds@(Some {})  None          = ds
+xorDigits (Some w1 ds1) (Some w2 ds2) = Some (w1 `xor#` w2) (xorDigits ds1 ds2)
+
+-- XXX We'd really like word2Double# for this
+doubleFromPositive :: Positive -> Double#
+doubleFromPositive None = 0.0##
+doubleFromPositive (Some w ds)
+    = case splitHalves w of
+      (# h, l #) ->
+       (doubleFromPositive ds *## (2.0## **## WORD_SIZE_IN_BITS_FLOAT##))
+       +## (int2Double# (word2Int# h) *##
+              (2.0## **## int2Double# (highHalfShift ())))
+       +## int2Double# (word2Int# l)
+
+-- XXX We'd really like word2Float# for this
+floatFromPositive :: Positive -> Float#
+floatFromPositive None = 0.0#
+floatFromPositive (Some w ds)
+    = case splitHalves w of
+      (# h, l #) ->
+       (floatFromPositive ds `timesFloat#` (2.0# `powerFloat#` WORD_SIZE_IN_BITS_FLOAT#))
+       `plusFloat#` (int2Float# (word2Int# h) `timesFloat#`
+             (2.0# `powerFloat#` int2Float# (highHalfShift ())))
+       `plusFloat#` int2Float# (word2Int# 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 ... ...
+-}
+

pkg/hs/urbit-integer-simple/urbit-integer-simple.cabal

@@ -0,0 +1,23 @@
+name:           urbit-integer-simple
+version:        0.1.1.1
+license:        BSD3
+license-file:   LICENSE
+maintainer:     igloo@earth.li
+synopsis:       Simple Integer library
+description:
+    This package contains an simple Integer library.
+cabal-version:  >=1.10
+build-type: Simple
+
+Library
+    default-language: Haskell2010
+
+    build-depends: ghc-prim
+    exposed-modules: Urbit.Integer
+                     Urbit.Integer.Simple.Internals
+                     Urbit.Integer.Logarithms
+                     Urbit.Integer.Logarithms.Internals
+    other-modules: Urbit.Integer.Type
+    default-extensions: CPP, MagicHash, BangPatterns, UnboxedTuples,
+                UnliftedFFITypes, NoImplicitPrelude
+    ghc-options: -Wall