[project @ 2002-02-04 09:05:45 by chak]

[ghc-hetmet.git] / ghc / lib / std / PrelBits.lhs

diff --git a/ghc/lib/std/PrelBits.lhs b/ghc/lib/std/PrelBits.lhs
index 24df47b..114ce2e 100644 (file)
--- a/ghc/lib/std/PrelBits.lhs
+++ b/ghc/lib/std/PrelBits.lhs
@@ -8,6 +8,9 @@ See library document for details on the semantics of the
 individual operations.
 
 \begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+#include "MachDeps.h"
+
 module PrelBits where
 
 #ifdef __GLASGOW_HASKELL__
@@ -20,35 +23,59 @@ import PrelNum
 --     Removing all fixities is a fairly safe fix; fixing the "one fixity
 --     per symbol per program" limitation in Hugs would take a lot longer.
 #ifndef __HUGS__
-infixl 8 `shift`, `rotate`
+infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
 infixl 7 .&.
 infixl 6 `xor`
 infixl 5 .|.
 #endif
 
 class Num a => Bits a where
-  (.&.), (.|.), xor :: a -> a -> a
-  complement        :: a -> a
-  shift             :: a -> Int -> a
-  rotate            :: a -> Int -> a
-  bit               :: Int -> a
-  setBit            :: a -> Int -> a
-  clearBit          :: a -> Int -> a
-  complementBit     :: a -> Int -> a
-  testBit           :: a -> Int -> Bool
-  bitSize           :: a -> Int
-  isSigned          :: a -> Bool
-
-  bit i             = shift 0x1 i
-  setBit x i        = x .|. bit i
-  clearBit x i      = x .&. complement (bit i)
-  complementBit x i = x `xor` bit i
-  testBit x i       = (x .&. bit i) /= 0
+    (.&.), (.|.), xor :: a -> a -> a
+    complement        :: a -> a
+    shift             :: a -> Int -> a
+    rotate            :: a -> Int -> a
+    bit               :: Int -> a
+    setBit            :: a -> Int -> a
+    clearBit          :: a -> Int -> a
+    complementBit     :: a -> Int -> a
+    testBit           :: a -> Int -> Bool
+    bitSize           :: a -> Int
+    isSigned          :: a -> Bool
+
+    bit i               = 1 `shift` i
+    x `setBit` i        = x .|. bit i
+    x `clearBit` i      = x .&. complement (bit i)
+    x `complementBit` i = x `xor` bit i
+    x `testBit` i       = (x .&. bit i) /= 0
 
 shiftL, shiftR   :: Bits a => a -> Int -> a
 rotateL, rotateR :: Bits a => a -> Int -> a
-shiftL  a i = shift  a i
-shiftR  a i = shift  a (-i)
-rotateL a i = rotate a i
-rotateR a i = rotate a (-i)
+x `shiftL`  i = x `shift`  i
+x `shiftR`  i = x `shift`  (-i)
+x `rotateL` i = x `rotate` i
+x `rotateR` i = x `rotate` (-i)
+
+instance Bits Int where
+    (I# x#) .&.   (I# y#)  = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
+    (I# x#) .|.   (I# y#)  = I# (word2Int# (int2Word# x# `or#`  int2Word# y#))
+    (I# x#) `xor` (I# y#)  = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+    complement (I# x#)     = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
+    (I# x#) `shift` (I# i#)
+        | i# ==# 0#     = I# x#
+        | i# >=# wsib   = 0
+        | i# ># 0#      = I# (x# `uncheckedIShiftL#` i#)
+        | i# <=# nwsib  = I# (if x# <# 0# then -1# else 0#)
+        | otherwise     = I# (x# `uncheckedIShiftRA#` negateInt# i#)
+          where
+            wsib  = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
+             nwsib = negateInt# wsib
+    (I# x#) `rotate` (I# i#) =
+        I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+                       (x'# `uncheckedShiftRL#` (wsib -# i'#))))
+        where
+           x'#   = int2Word# x#
+           i'#   = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+          wsib  = WORD_SIZE_IN_BITS#
+    bitSize  _                 = WORD_SIZE_IN_BITS
+    isSigned _                 = True
 \end{code}