From b73a4bf2dbb5f93abae802a437567db65987df5d Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Wed, 22 Jul 2009 13:15:07 +0000
Subject: [PATCH] Follow changes in GHC and the other libraries
---
GHC/Integer.hs | 68 ++++++++++++++++++---------
GHC/Integer/Simple/Internals.hs | 23 +++++++++
GHC/Integer/Type.hs | 51 ++++++++++++++++++++
integer.cabal => integer-simple.cabal | 10 ++--
4 files changed, 126 insertions(+), 26 deletions(-)
create mode 100644 GHC/Integer/Simple/Internals.hs
create mode 100644 GHC/Integer/Type.hs
rename integer.cabal => integer-simple.cabal (60%)
diff --git a/GHC/Integer.hs b/GHC/Integer.hs
index c9a400f..d00e183 100644
--- a/GHC/Integer.hs
+++ b/GHC/Integer.hs
@@ -1,10 +1,12 @@
-{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}
+{-# LANGUAGE CPP, MagicHash, ForeignFunctionInterface,
+ NoImplicitPrelude, BangPatterns, UnboxedTuples,
+ UnliftedFFITypes #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Integer
--- Copyright : (c) Ian Lnyagh 2007-2008
+-- Copyright : (c) Ian Lynagh 2007-2008
-- License : BSD3
--
-- Maintainer : igloo@earth.li
@@ -32,9 +34,12 @@ module GHC.Integer (
encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
-- gcdInteger, lcmInteger, -- XXX
andInteger, orInteger, xorInteger, complementInteger,
+ shiftLInteger, shiftRInteger,
hashInteger,
) where
+import GHC.Integer.Type
+
import GHC.Bool
import GHC.Ordering
import GHC.Prim
@@ -50,8 +55,6 @@ errorInteger = Positive errorPositive
errorPositive :: Positive
errorPositive = Some 47## None -- Random number
-data Integer = Positive !Positive | Negative !Positive | Naught
-
smallInteger :: Int# -> Integer
smallInteger i = if i >=# 0# then wordToInteger (int2Word# i)
else -- XXX is this right for -minBound?
@@ -268,6 +271,17 @@ Negative x `xorInteger` Negative y = let x' = x `minusPositive` onePositive
complementInteger :: Integer -> Integer
complementInteger x = negativeOneInteger `minusInteger` x
+shiftLInteger :: Integer -> Int# -> Integer
+shiftLInteger (Positive p) i = Positive (shiftLPositive p i)
+shiftLInteger (Negative n) i = Negative (shiftLPositive n i)
+shiftLInteger Naught _ = Naught
+
+shiftRInteger :: Integer -> Int# -> Integer
+shiftRInteger (Positive p) i = shiftRPositive p i
+shiftRInteger j@(Negative _) i
+ = complementInteger (shiftRInteger (complementInteger j) i)
+shiftRInteger Naught _ = Naught
+
twosComplementPositive :: Positive -> DigitsOnes
twosComplementPositive p = flipBits (p `minusPositive` onePositive)
@@ -392,23 +406,9 @@ hashInteger (!_) = 42#
-------------------------------------------------------------------
-- 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 Unit = Unit
--- XXX Could move [] above us
-data List a = Nil | Cons a (List a)
-
onePositive :: Positive
onePositive = Some 1## None
@@ -614,10 +614,17 @@ splitHalves :: Digit -> (# {- High -} Digit, {- Low -} Digit #)
splitHalves (!x) = (# x `uncheckedShiftRL#` highHalfShift Unit,
x `and#` lowHalfMask Unit #)
--- Assumes 0 <= i <= 31
+-- Assumes 0 <= i
shiftLPositive :: Positive -> Int# -> Positive
-shiftLPositive None (!_) = None -- XXX Can't happen
-shiftLPositive (!p) (!i) =
+shiftLPositive p i
+ = if 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 carry `eqWord#` 0##
then None
@@ -629,6 +636,23 @@ shiftLPositive (!p) (!i) =
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 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 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)
@@ -641,7 +665,7 @@ quotRemPositive :: Positive -> Positive -> (# Integer, Integer #)
mkSubtractors (!n) = if n ==# 0#
then Cons ys Nil
- else Cons (ys `shiftLPositive` n)
+ else Cons (ys `smallShiftLPositive` n)
(mkSubtractors (n -# 1#))
-- The main function. Go the the end of xs, then walk
diff --git a/GHC/Integer/Simple/Internals.hs b/GHC/Integer/Simple/Internals.hs
new file mode 100644
index 0000000..64d0d6f
--- /dev/null
+++ b/GHC/Integer/Simple/Internals.hs
@@ -0,0 +1,23 @@
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : GHC.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 GHC.Integer.Simple.Internals (
+ module GHC.Integer.Type
+ ) where
+
+import GHC.Integer.Type
+
diff --git a/GHC/Integer/Type.hs b/GHC/Integer/Type.hs
new file mode 100644
index 0000000..33a8cd8
--- /dev/null
+++ b/GHC/Integer/Type.hs
@@ -0,0 +1,51 @@
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : GHC.Integer.Type
+-- 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.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Integer.Type (
+ Integer(..),
+ Positive, Positives,
+ Digits(..), Digit,
+ List(..)
+ ) where
+
+import GHC.Prim
+
+#if !defined(__HADDOCK__)
+
+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)
+
+#endif
+
diff --git a/integer.cabal b/integer-simple.cabal
similarity index 60%
rename from integer.cabal
rename to integer-simple.cabal
index fff99f2..b137dd8 100644
--- a/integer.cabal
+++ b/integer-simple.cabal
@@ -1,4 +1,4 @@
-name: integer
+name: integer-simple
version: 0.1
license: BSD3
license-file: LICENSE
@@ -12,9 +12,11 @@ build-type: Simple
Library {
build-depends: ghc-prim
exposed-modules: GHC.Integer
+ GHC.Integer.Simple.Internals
+ other-modules: GHC.Integer.Type
extensions: CPP, MagicHash, BangPatterns, UnboxedTuples,
ForeignFunctionInterface, UnliftedFFITypes
- -- We need to set the package name to integer (without a version number)
- -- as it's magic.
- ghc-options: -package-name integer -Wall -Werror
+ -- We need to set the package name to integer-simple
+ -- (without a version number) as it's magic.
+ ghc-options: -package-name integer-simple -Wall -Werror
}
--
GitLab