diff options
| -rw-r--r-- | libraries/integer-simple/GHC/Integer.hs | 68 | ||||
| -rw-r--r-- | libraries/integer-simple/GHC/Integer/Simple/Internals.hs | 23 | ||||
| -rw-r--r-- | libraries/integer-simple/GHC/Integer/Type.hs | 51 | ||||
| -rw-r--r-- | libraries/integer-simple/integer-simple.cabal (renamed from libraries/integer-simple/integer.cabal) | 10 |
4 files changed, 126 insertions, 26 deletions
diff --git a/libraries/integer-simple/GHC/Integer.hs b/libraries/integer-simple/GHC/Integer.hs index c9a400f345..d00e183ab9 100644 --- a/libraries/integer-simple/GHC/Integer.hs +++ b/libraries/integer-simple/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/libraries/integer-simple/GHC/Integer/Simple/Internals.hs b/libraries/integer-simple/GHC/Integer/Simple/Internals.hs new file mode 100644 index 0000000000..64d0d6fd79 --- /dev/null +++ b/libraries/integer-simple/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/libraries/integer-simple/GHC/Integer/Type.hs b/libraries/integer-simple/GHC/Integer/Type.hs new file mode 100644 index 0000000000..33a8cd85a7 --- /dev/null +++ b/libraries/integer-simple/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/libraries/integer-simple/integer.cabal b/libraries/integer-simple/integer-simple.cabal index fff99f2736..b137dd8997 100644 --- a/libraries/integer-simple/integer.cabal +++ b/libraries/integer-simple/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 } |