X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FWord.hs;h=0c9741d4d6a99e78bc78e987a674bb92e565c746;hb=8dff2a318448b67a99627d54bbad1108010cb61e;hp=2332c13c50e87470323e905ecc5695bd31c4e85f;hpb=be44c54248f9a5a5bd6168af464013b405c15aab;p=haskell-directory.git diff --git a/GHC/Word.hs b/GHC/Word.hs index 2332c13..0c9741d 100644 --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Word @@ -16,6 +16,7 @@ #include "MachDeps.h" +-- #hide module GHC.Word ( Word(..), Word8(..), Word16(..), Word32(..), Word64(..), toEnumError, fromEnumError, succError, predError) @@ -69,9 +70,6 @@ predError inst_ty = -- |A 'Word' is an unsigned integral type, with the same size as 'Int'. data Word = W# Word# deriving (Eq, Ord) -instance CCallable Word -instance CReturnable Word - instance Show Word where showsPrec p x = showsPrec p (toInteger x) @@ -135,24 +133,28 @@ instance Integral Word where instance Bounded Word where minBound = 0 + + -- use unboxed literals for maxBound, because GHC doesn't optimise + -- (fromInteger 0xffffffff :: Word). #if WORD_SIZE_IN_BITS == 31 - maxBound = 0x7FFFFFFF + maxBound = W# (int2Word# 0x7FFFFFFF#) #elif WORD_SIZE_IN_BITS == 32 - maxBound = 0xFFFFFFFF + maxBound = W# (int2Word# 0xFFFFFFFF#) #else - maxBound = 0xFFFFFFFFFFFFFFFF + maxBound = W# (int2Word# 0xFFFFFFFFFFFFFFFF#) #endif instance Ix Word where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n - unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1 instance Read Word where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] instance Bits Word where + {-# INLINE shift #-} + (W# x#) .&. (W# y#) = W# (x# `and#` y#) (W# x#) .|. (W# y#) = W# (x# `or#` y#) (W# x#) `xor` (W# y#) = W# (x# `xor#` y#) @@ -162,7 +164,7 @@ instance Bits Word where | otherwise = W# (x# `shiftRL#` negateInt# i#) (W# x#) `rotate` (I# i#) | i'# ==# 0# = W# x# - | otherwise = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (wsib -# i'#))) + | otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#))) where i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#)) wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} @@ -185,9 +187,6 @@ instance Bits Word where data Word8 = W8# Word# deriving (Eq, Ord) -- ^ 8-bit unsigned integer type -instance CCallable Word8 -instance CReturnable Word8 - instance Show Word8 where showsPrec p x = showsPrec p (fromIntegral x :: Int) @@ -249,12 +248,13 @@ instance Ix Word8 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n - unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1 instance Read Word8 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] instance Bits Word8 where + {-# INLINE shift #-} + (W8# x#) .&. (W8# y#) = W8# (x# `and#` y#) (W8# x#) .|. (W8# y#) = W8# (x# `or#` y#) (W8# x#) `xor` (W8# y#) = W8# (x# `xor#` y#) @@ -264,8 +264,8 @@ instance Bits Word8 where | otherwise = W8# (x# `shiftRL#` negateInt# i#) (W8# x#) `rotate` (I# i#) | i'# ==# 0# = W8# x# - | otherwise = W8# (narrow8Word# ((x# `shiftL#` i'#) `or#` - (x# `shiftRL#` (8# -# i'#)))) + | otherwise = W8# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#` + (x# `uncheckedShiftRL#` (8# -# i'#)))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 7#) bitSize _ = 8 @@ -288,9 +288,6 @@ instance Bits Word8 where data Word16 = W16# Word# deriving (Eq, Ord) -- ^ 16-bit unsigned integer type -instance CCallable Word16 -instance CReturnable Word16 - instance Show Word16 where showsPrec p x = showsPrec p (fromIntegral x :: Int) @@ -352,12 +349,13 @@ instance Ix Word16 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n - unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1 instance Read Word16 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] instance Bits Word16 where + {-# INLINE shift #-} + (W16# x#) .&. (W16# y#) = W16# (x# `and#` y#) (W16# x#) .|. (W16# y#) = W16# (x# `or#` y#) (W16# x#) `xor` (W16# y#) = W16# (x# `xor#` y#) @@ -367,8 +365,8 @@ instance Bits Word16 where | otherwise = W16# (x# `shiftRL#` negateInt# i#) (W16# x#) `rotate` (I# i#) | i'# ==# 0# = W16# x# - | otherwise = W16# (narrow16Word# ((x# `shiftL#` i'#) `or#` - (x# `shiftRL#` (16# -# i'#)))) + | otherwise = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#` + (x# `uncheckedShiftRL#` (16# -# i'#)))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 15#) bitSize _ = 16 @@ -455,6 +453,8 @@ instance Integral Word32 where | otherwise = case word32ToInteger# x# of (# s, d #) -> J# s d instance Bits Word32 where + {-# INLINE shift #-} + (W32# x#) .&. (W32# y#) = W32# (x# `and32#` y#) (W32# x#) .|. (W32# y#) = W32# (x# `or32#` y#) (W32# x#) `xor` (W32# y#) = W32# (x# `xor32#` y#) @@ -584,6 +584,8 @@ instance Integral Word32 where #endif instance Bits Word32 where + {-# INLINE shift #-} + (W32# x#) .&. (W32# y#) = W32# (x# `and#` y#) (W32# x#) .|. (W32# y#) = W32# (x# `or#` y#) (W32# x#) `xor` (W32# y#) = W32# (x# `xor#` y#) @@ -593,8 +595,8 @@ instance Bits Word32 where | otherwise = W32# (x# `shiftRL#` negateInt# i#) (W32# x#) `rotate` (I# i#) | i'# ==# 0# = W32# x# - | otherwise = W32# (narrow32Word# ((x# `shiftL#` i'#) `or#` - (x# `shiftRL#` (32# -# i'#)))) + | otherwise = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#` + (x# `uncheckedShiftRL#` (32# -# i'#)))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) bitSize _ = 32 @@ -611,9 +613,6 @@ instance Bits Word32 where #endif -instance CCallable Word32 -instance CReturnable Word32 - instance Show Word32 where #if WORD_SIZE_IN_BITS < 33 showsPrec p x = showsPrec p (toInteger x) @@ -633,7 +632,6 @@ instance Ix Word32 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n - unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1 instance Read Word32 where #if WORD_SIZE_IN_BITS < 33 @@ -715,6 +713,8 @@ instance Integral Word64 where | otherwise = case word64ToInteger# x# of (# s, d #) -> J# s d instance Bits Word64 where + {-# INLINE shift #-} + (W64# x#) .&. (W64# y#) = W64# (x# `and64#` y#) (W64# x#) .|. (W64# y#) = W64# (x# `or64#` y#) (W64# x#) `xor` (W64# y#) = W64# (x# `xor64#` y#) @@ -745,31 +745,31 @@ a `shiftRL64#` b | b >=# 64# = wordToWord64# (int2Word# 0#) | otherwise = a `uncheckedShiftRL64#` b -foreign import ccall unsafe "stg_eqWord64" eqWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_neWord64" neWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_ltWord64" ltWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_leWord64" leWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_gtWord64" gtWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_geWord64" geWord64# :: Word64# -> Word64# -> Bool -foreign import ccall unsafe "stg_int64ToWord64" int64ToWord64# :: Int64# -> Word64# -foreign import ccall unsafe "stg_word64ToInt64" word64ToInt64# :: Word64# -> Int64# -foreign import ccall unsafe "stg_intToInt64" intToInt64# :: Int# -> Int64# -foreign import ccall unsafe "stg_wordToWord64" wordToWord64# :: Word# -> Word64# -foreign import ccall unsafe "stg_word64ToWord" word64ToWord# :: Word64# -> Word# -foreign import ccall unsafe "stg_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64# -foreign import ccall unsafe "stg_negateInt64" negateInt64# :: Int64# -> Int64# -foreign import ccall unsafe "stg_quotWord64" quotWord64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_remWord64" remWord64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_and64" and64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_or64" or64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_xor64" xor64# :: Word64# -> Word64# -> Word64# -foreign import ccall unsafe "stg_not64" not64# :: Word64# -> Word64# -foreign import ccall unsafe "stg_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# -foreign import ccall unsafe "stg_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# - -foreign import ccall unsafe "stg_integerToWord64" integerToWord64# :: Int# -> ByteArray# -> Word64# +foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_neWord64" neWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_ltWord64" ltWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_leWord64" leWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_gtWord64" gtWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_geWord64" geWord64# :: Word64# -> Word64# -> Bool +foreign import ccall unsafe "hs_int64ToWord64" int64ToWord64# :: Int64# -> Word64# +foreign import ccall unsafe "hs_word64ToInt64" word64ToInt64# :: Word64# -> Int64# +foreign import ccall unsafe "hs_intToInt64" intToInt64# :: Int# -> Int64# +foreign import ccall unsafe "hs_wordToWord64" wordToWord64# :: Word# -> Word64# +foreign import ccall unsafe "hs_word64ToWord" word64ToWord# :: Word64# -> Word# +foreign import ccall unsafe "hs_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "hs_negateInt64" negateInt64# :: Int64# -> Int64# +foreign import ccall unsafe "hs_quotWord64" quotWord64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_remWord64" remWord64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_and64" and64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_or64" or64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_xor64" xor64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "hs_not64" not64# :: Word64# -> Word64# +foreign import ccall unsafe "hs_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# +foreign import ccall unsafe "hs_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# + +foreign import ccall unsafe "hs_integerToWord64" integerToWord64# :: Int# -> ByteArray# -> Word64# {-# RULES @@ -845,6 +845,8 @@ instance Integral Word64 where i# = word2Int# x# instance Bits Word64 where + {-# INLINE shift #-} + (W64# x#) .&. (W64# y#) = W64# (x# `and#` y#) (W64# x#) .|. (W64# y#) = W64# (x# `or#` y#) (W64# x#) `xor` (W64# y#) = W64# (x# `xor#` y#) @@ -854,8 +856,8 @@ instance Bits Word64 where | otherwise = W64# (x# `shiftRL#` negateInt# i#) (W64# x#) `rotate` (I# i#) | i'# ==# 0# = W64# x# - | otherwise = W64# ((x# `shiftL#` i'#) `or#` - (x# `shiftRL#` (64# -# i'#))) + | otherwise = W64# ((x# `uncheckedShiftL#` i'#) `or#` + (x# `uncheckedShiftRL#` (64# -# i'#))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 @@ -868,9 +870,6 @@ instance Bits Word64 where #endif -instance CCallable Word64 -instance CReturnable Word64 - instance Show Word64 where showsPrec p x = showsPrec p (toInteger x) @@ -885,7 +884,6 @@ instance Ix Word64 where range (m,n) = [m..n] unsafeIndex b@(m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n - unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1 instance Read Word64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]