From e84b92ee647e749ea48fecf3ad1f4f328f667a70 Mon Sep 17 00:00:00 2001 From: sof Date: Thu, 22 Jan 1998 15:51:31 +0000 Subject: [PATCH] [project @ 1998-01-22 15:51:30 by sof] * Int and Word rewritten to use unboxed types and operations. --- ghc/lib/glaExts/Bits.lhs | 8 +- ghc/lib/glaExts/Int.lhs | 479 ++++++++++++++++++++++++++++--------------- ghc/lib/glaExts/Word.lhs | 508 +++++++++++++++++++++++++++++++--------------- 3 files changed, 662 insertions(+), 333 deletions(-) diff --git a/ghc/lib/glaExts/Bits.lhs b/ghc/lib/glaExts/Bits.lhs index 3a7a3b3..f47aa8f 100644 --- a/ghc/lib/glaExts/Bits.lhs +++ b/ghc/lib/glaExts/Bits.lhs @@ -1,7 +1,11 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1998 % -\section[Bits]{The @Bits@ Module} +\section[Bits]{The @Bits@ interface} + +Defines the @Bits@ class containing bit-based operations. +See library document for details on the semantics of the +individual operations. \begin{code} {-# OPTIONS -fno-implicit-prelude #-} diff --git a/ghc/lib/glaExts/Int.lhs b/ghc/lib/glaExts/Int.lhs index 1ef116f..5fa62e6 100644 --- a/ghc/lib/glaExts/Int.lhs +++ b/ghc/lib/glaExts/Int.lhs @@ -1,5 +1,5 @@ % -% (c) The AQUA Project, Glasgow University, 1994-1996 +% (c) The AQUA Project, Glasgow University, 1997-1998 % \section[Int]{Module @Int@} @@ -33,9 +33,10 @@ import PrelBase import PrelNum import PrelRead import Ix -import Error +import GHCerr ( error ) import Bits import GHC +import CCall ----------------------------------------------------------------------------- -- The "official" coercion functions @@ -57,37 +58,60 @@ int16ToInt32 :: Int16 -> Int32 int32ToInt8 :: Int32 -> Int8 int32ToInt16 :: Int32 -> Int16 -int8ToInt16 = I16 . int8ToInt -int8ToInt32 = I32 . int8ToInt -int16ToInt8 = I8 . int16ToInt -int16ToInt32 = I32 . int16ToInt -int32ToInt8 = I8 . int32ToInt -int32ToInt16 = I16 . int32ToInt +int8ToInt16 (I8# x) = I16# x +int8ToInt32 (I8# x) = I32# x +int16ToInt8 (I16# x) = I8# x +int16ToInt32 (I16# x) = I32# x +int32ToInt8 (I32# x) = I8# x +int32ToInt16 (I32# x) = I16# x +\end{code} ------------------------------------------------------------------------------ --- Int8 ------------------------------------------------------------------------------ +\subsection[Int8]{The @Int8@ interface} + +\begin{code} +data Int8 = I8# Int# +instance CCallable Int8 +instance CReturnable Int8 -newtype Int8 = I8 Int +int8ToInt (I8# x) = I# (int8ToInt# x) +int8ToInt# x = if x' <=# 0x7f# then x' else x' -# 0x100# + where x' = word2Int# (int2Word# x `and#` int2Word# 0xff#) -int8ToInt (I8 x) = if x' <= 0x7f then x' else x' - 0x100 - where x' = case x of { I# x -> - I# (word2Int# (int2Word# x `and#` int2Word# 0xff#)) - } -intToInt8 = I8 +-- +-- This doesn't perform any bounds checking +-- on the value it is passed, nor its sign. +-- i.e., show (intToInt8 511) => "-1" +-- +intToInt8 (I# x) = I8# (intToInt8# x) +intToInt8# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xff#) + +instance Eq Int8 where + (I8# x#) == (I8# y#) = x# ==# y# + (I8# x#) /= (I8# y#) = x# /=# y# -instance Eq Int8 where (==) = binop (==) -instance Ord Int8 where compare = binop compare +instance Ord Int8 where + compare (I8# x#) (I8# y#) = compareInt# (int8ToInt# x#) (int8ToInt# y#) + +compareInt# :: Int# -> Int# -> Ordering +compareInt# x# y# + | x# <# y# = LT + | x# ==# y# = EQ + | otherwise = GT instance Num Int8 where - x + y = to (binop (+) x y) - x - y = to (binop (-) x y) - negate = to . negate . from - x * y = to (binop (*) x y) - abs = absReal - signum = signumReal - fromInteger = to . fromInteger - fromInt = to + (I8# x#) + (I8# y#) = I8# (intToInt8# (x# +# y#)) + (I8# x#) - (I8# y#) = I8# (intToInt8# (x# -# y#)) + (I8# x#) * (I8# y#) = I8# (intToInt8# (x# *# y#)) + negate i@(I8# x#) = + if x# ==# 0# + then i + else I8# (0x100# -# x#) + + abs = absReal + signum = signumReal + fromInteger (J# a# s# d#) + = case (integer2Int# a# s# d#) of { i# -> I8# (intToInt8# i#) } + fromInt = intToInt8 instance Bounded Int8 where minBound = 0x80 @@ -97,76 +121,126 @@ instance Real Int8 where toRational x = toInteger x % 1 instance Integral Int8 where - x `div` y = to (binop div x y) - x `quot` y = to (binop quot x y) - x `rem` y = to (binop rem x y) - x `mod` y = to (binop mod x y) - x `quotRem` y = to2 (binop quotRem x y) - toInteger = toInteger . from - toInt = toInt . from + div x@(I8# x#) y@(I8# y#) = + if x > 0 && y < 0 then quotInt8 (x-y-1) y + else if x < 0 && y > 0 then quotInt8 (x-y+1) y + else quotInt8 x y + quot x@(I8# _) y@(I8# y#) = + if y# /=# 0# + then x `quotInt8` y + else error "Integral.Int8.quot: divide by 0\n" + rem x@(I8# _) y@(I8# y#) = + if y# /=# 0# + then x `remInt8` y + else error "Integral.Int8.rem: divide by 0\n" + mod x@(I8# x#) y@(I8# y#) = + if x > 0 && y < 0 || x < 0 && y > 0 then + if r/=0 then r+y else 0 + else + r + where r = remInt8 x y + a@(I8# _) `quotRem` b@(I8# _) = (a `quotInt8` b, a `remInt8` b) + toInteger i8 = toInteger (int8ToInt i8) + toInt i8 = int8ToInt i8 + +remInt8 (I8# x) (I8# y) = I8# (intToInt8# ((int8ToInt# x) `remInt#` (int8ToInt# y))) +quotInt8 (I8# x) (I8# y) = I8# (intToInt8# ((int8ToInt# x) `quotInt#` (int8ToInt# y))) instance Ix Int8 where range (m,n) = [m..n] index b@(m,n) i - | inRange b i = from (i - m) - | otherwise = error "index: Index out of range" + | inRange b i = int8ToInt (i - m) + | otherwise = error (showString "Ix{Int8}.index: Index " . + showParen True (showsPrec 0 i) . + showString " out of range " $ + showParen True (showsPrec 0 b) "") inRange (m,n) i = m <= i && i <= n instance Enum Int8 where - toEnum = to - fromEnum = from + toEnum = intToInt8 + fromEnum = int8ToInt enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Int8)] enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int8)] where last = if d < c then minBound else maxBound instance Read Int8 where - readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ] + readsPrec p s = [ (intToInt8 x,r) | (x,r) <- readsPrec p s ] instance Show Int8 where - showsPrec p = showsPrec p . from + showsPrec p i8 = showsPrec p (int8ToInt i8) binop8 :: (Int32 -> Int32 -> a) -> (Int8 -> Int8 -> a) binop8 op x y = int8ToInt32 x `op` int8ToInt32 y instance Bits Int8 where - x .&. y = int32ToInt8 (binop8 (.&.) x y) - x .|. y = int32ToInt8 (binop8 (.|.) x y) - x `xor` y = int32ToInt8 (binop8 xor x y) - complement = int32ToInt8 . complement . int8ToInt32 - x `shift` i = int32ToInt8 (int8ToInt32 x `shift` i) --- rotate - bit = int32ToInt8 . bit - setBit x i = int32ToInt8 (setBit (int8ToInt32 x) i) - clearBit x i = int32ToInt8 (clearBit (int8ToInt32 x) i) - complementBit x i = int32ToInt8 (complementBit (int8ToInt32 x) i) - testBit x i = testBit (int8ToInt32 x) i + (I8# x) .&. (I8# y) = I8# (word2Int# ((int2Word# x) `and#` (int2Word# y))) + (I8# x) .|. (I8# y) = I8# (word2Int# ((int2Word# x) `or#` (int2Word# y))) + (I8# x) `xor` (I8# y) = I8# (word2Int# ((int2Word# x) `xor#` (int2Word# y))) + complement (I8# x) = I8# (word2Int# ((int2Word# x) `xor#` (int2Word# 0xff#))) + shift (I8# x) i@(I# i#) + | i > 0 = I8# (intToInt8# (iShiftL# (int8ToInt# x) i#)) + | otherwise = I8# (intToInt8# (iShiftRA# (int8ToInt# x) i#)) + i8@(I8# x) `rotate` (I# i) + | i ==# 0# = i8 + | i ># 0# = + I8# (intToInt8# ( word2Int# ( + (int2Word# (iShiftL# (int8ToInt# x) i')) + `or#` + (int2Word# (iShiftRA# (word2Int# ( + (int2Word# x) `and#` + (int2Word# (0x100# -# pow2# i2)))) + i2))))) + | otherwise = rotate i8 (I# (8# +# i)) + where + i' = word2Int# (int2Word# i `and#` int2Word# 7#) + i2 = 8# -# i' + bit i = shift 1 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 bitSize _ = 8 isSigned _ = True ------------------------------------------------------------------------------ --- Int16 ------------------------------------------------------------------------------ +pow2# :: Int# -> Int# +pow2# x# = iShiftL# 1# x# +\end{code} + +\subsection[Int16]{The @Int16@ interface} + +\begin{code} +data Int16 = I16# Int# +instance CCallable Int16 +instance CReturnable Int16 -newtype Int16 = I16 Int +int16ToInt (I16# x) = I# (int16ToInt# x) -int16ToInt (I16 x) = if x' <= 0x7fff then x' else x' - 0x10000 - where x' = case x of { I# x -> - I# (word2Int# (int2Word# x `and#` int2Word# 0xffff#)) - } -intToInt16 = I16 +int16ToInt# x = if x' <=# 0x7fff# then x' else x' -# 0x10000# + where x' = word2Int# (int2Word# x `and#` int2Word# 0xffff#) -instance Eq Int16 where (==) = binop (==) -instance Ord Int16 where compare = binop compare +intToInt16 (I# x) = I16# (intToInt16# x) +intToInt16# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xffff#) + +instance Eq Int16 where + (I16# x#) == (I16# y#) = x# ==# y# + (I16# x#) /= (I16# y#) = x# /=# y# + +instance Ord Int16 where + compare (I16# x#) (I16# y#) = compareInt# (int16ToInt# x#) (int16ToInt# y#) instance Num Int16 where - x + y = to (binop (+) x y) - x - y = to (binop (-) x y) - negate = to . negate . from - x * y = to (binop (*) x y) - abs = absReal - signum = signumReal - fromInteger = to . fromInteger - fromInt = to + (I16# x#) + (I16# y#) = I16# (intToInt16# (x# +# y#)) + (I16# x#) - (I16# y#) = I16# (intToInt16# (x# -# y#)) + (I16# x#) * (I16# y#) = I16# (intToInt16# (x# *# y#)) + negate i@(I16# x#) = + if x# ==# 0# + then i + else I16# (0x10000# -# x#) + abs = absReal + signum = signumReal + fromInteger (J# a# s# d#) + = case (integer2Int# a# s# d#) of { i# -> I16# (intToInt16# i#) } + fromInt = intToInt16 instance Bounded Int16 where minBound = 0x8000 @@ -176,122 +250,225 @@ instance Real Int16 where toRational x = toInteger x % 1 instance Integral Int16 where - x `div` y = to (binop div x y) - x `quot` y = to (binop quot x y) - x `rem` y = to (binop rem x y) - x `mod` y = to (binop mod x y) - x `quotRem` y = to2 (binop quotRem x y) - toInteger = toInteger . from - toInt = toInt . from + div x@(I16# x#) y@(I16# y#) = + if x > 0 && y < 0 then quotInt16 (x-y-1) y + else if x < 0 && y > 0 then quotInt16 (x-y+1) y + else quotInt16 x y + quot x@(I16# _) y@(I16# y#) = + if y# /=# 0# + then x `quotInt16` y + else error "Integral.Int16.quot: divide by 0\n" + rem x@(I16# _) y@(I16# y#) = + if y# /=# 0# + then x `remInt16` y + else error "Integral.Int16.rem: divide by 0\n" + mod x@(I16# x#) y@(I16# y#) = + if x > 0 && y < 0 || x < 0 && y > 0 then + if r/=0 then r+y else 0 + else + r + where r = remInt16 x y + a@(I16# _) `quotRem` b@(I16# _) = (a `quotInt16` b, a `remInt16` b) + toInteger i16 = toInteger (int16ToInt i16) + toInt i16 = int16ToInt i16 + +remInt16 (I16# x) (I16# y) = I16# (intToInt16# ((int16ToInt# x) `remInt#` (int16ToInt# y))) +quotInt16 (I16# x) (I16# y) = I16# (intToInt16# ((int16ToInt# x) `quotInt#` (int16ToInt# y))) instance Ix Int16 where range (m,n) = [m..n] index b@(m,n) i - | inRange b i = from (i - m) - | otherwise = error "index: Index out of range" + | inRange b i = int16ToInt (i - m) + | otherwise = error (showString "Ix{Int16}.index: Index " . + showParen True (showsPrec 0 i) . + showString " out of range " $ + showParen True (showsPrec 0 b) "") inRange (m,n) i = m <= i && i <= n instance Enum Int16 where - toEnum = to - fromEnum = from + toEnum = intToInt16 + fromEnum = int16ToInt enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Int16)] enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int16)] where last = if d < c then minBound else maxBound instance Read Int16 where - readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ] + readsPrec p s = [ (intToInt16 x,r) | (x,r) <- readsPrec p s ] instance Show Int16 where - showsPrec p = showsPrec p . from + showsPrec p i16 = showsPrec p (int16ToInt i16) binop16 :: (Int32 -> Int32 -> a) -> (Int16 -> Int16 -> a) binop16 op x y = int16ToInt32 x `op` int16ToInt32 y instance Bits Int16 where - x .&. y = int32ToInt16 (binop16 (.&.) x y) - x .|. y = int32ToInt16 (binop16 (.|.) x y) - x `xor` y = int32ToInt16 (binop16 xor x y) - complement = int32ToInt16 . complement . int16ToInt32 - x `shift` i = int32ToInt16 (int16ToInt32 x `shift` i) --- rotate - bit = int32ToInt16 . bit - setBit x i = int32ToInt16 (setBit (int16ToInt32 x) i) - clearBit x i = int32ToInt16 (clearBit (int16ToInt32 x) i) - complementBit x i = int32ToInt16 (complementBit (int16ToInt32 x) i) - testBit x i = testBit (int16ToInt32 x) i - bitSize _ = 16 - isSigned _ = True - ------------------------------------------------------------------------------ --- Int32 ------------------------------------------------------------------------------ - -newtype Int32 = I32 Int + (I16# x) .&. (I16# y) = I16# (word2Int# ((int2Word# x) `and#` (int2Word# y))) + (I16# x) .|. (I16# y) = I16# (word2Int# ((int2Word# x) `or#` (int2Word# y))) + (I16# x) `xor` (I16# y) = I16# (word2Int# ((int2Word# x) `xor#` (int2Word# y))) + complement (I16# x) = I16# (word2Int# ((int2Word# x) `xor#` (int2Word# 0xffff#))) + shift (I16# x) i@(I# i#) + | i > 0 = I16# (intToInt16# (iShiftL# (int16ToInt# x) i#)) + | otherwise = I16# (intToInt16# (iShiftRA# (int16ToInt# x) i#)) + i16@(I16# x) `rotate` (I# i) + | i ==# 0# = i16 + | i ># 0# = + I16# (intToInt16# (word2Int# ( + (int2Word# (iShiftL# (int16ToInt# x) i')) + `or#` + (int2Word# (iShiftRA# ( word2Int# ( + (int2Word# x) `and#` (int2Word# (0x100# -# pow2# i2)))) + i2))))) + | otherwise = rotate i16 (I# (16# +# i)) + where + i' = word2Int# (int2Word# i `and#` int2Word# 15#) + i2 = 16# -# i' + bit i = shift 1 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 + bitSize _ = 16 + isSigned _ = True +\end{code} -int32ToInt (I32 x) = x -intToInt32 = I32 +\subsection[Int32]{The @Int32@ interface} -instance Eq Int32 where (==) = binop (==) -instance Ord Int32 where compare = binop compare +\begin{code} +data Int32 = I32# Int# +instance CCallable Int32 +instance CReturnable Int32 + +int32ToInt (I32# x) = I# (int32ToInt# x) + +int32ToInt# :: Int# -> Int# +#if WORD_SIZE_IN_BYTES > 4 +int32ToInt# x = if x' <=# 0x7fffffff# then x' else x' -# 0x100000000# + where x' = word2Int# (int2Word# x `and#` int2Word# 0xffffffff#) +#else +int32ToInt# x = x +#endif + +intToInt32 (I# x) = I32# (intToInt32# x) +intToInt32# :: Int# -> Int# +#if WORD_SIZE_IN_BYTES > 4 +intToInt32# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xffffffff#) +#else +intToInt32# i# = i# +#endif + +instance Eq Int32 where + (I32# x#) == (I32# y#) = x# ==# y# + (I32# x#) /= (I32# y#) = x# /=# y# + +instance Ord Int32 where + compare (I32# x#) (I32# y#) = compareInt# (int32ToInt# x#) (int32ToInt# y#) instance Num Int32 where - x + y = to (binop (+) x y) - x - y = to (binop (-) x y) - negate = to . negate . from - x * y = to (binop (*) x y) - abs = absReal - signum = signumReal - fromInteger = to . fromInteger - fromInt = to + (I32# x#) + (I32# y#) = I32# (intToInt32# (x# +# y#)) + (I32# x#) - (I32# y#) = I32# (intToInt32# (x# -# y#)) + (I32# x#) * (I32# y#) = I32# (intToInt32# (x# *# y#)) +#if WORD_SIZE_IN_BYTES > 4 + negate i@(I32# x) = + if x ==# 0# + then i + else I32# (intToInt32# (0x100000000# -# x')) +#else + negate (I32# x) = I32# (negateInt# x) +#endif + abs = absReal + signum = signumReal + fromInteger (J# a# s# d#) + = case (integer2Int# a# s# d#) of { i# -> I32# (intToInt32# i#) } + fromInt = intToInt32 -- ToDo: remove LitLit when minBound::Int is fixed (currently it's one -- too high, and doesn't allow the correct minBound to be defined here). instance Bounded Int32 where - minBound = I32 ``0x80000000'' - maxBound = I32 0x7fffffff + minBound = case ``0x80000000'' of { I# x -> I32# x } + maxBound = I32# 0x7fffffff# instance Real Int32 where toRational x = toInteger x % 1 instance Integral Int32 where - x `div` y = to (binop div x y) - x `quot` y = to (binop quot x y) - x `rem` y = to (binop rem x y) - x `mod` y = to (binop mod x y) - x `quotRem` y = to2 (binop quotRem x y) - toInteger = toInteger . from - toInt = toInt . from + div x@(I32# x#) y@(I32# y#) = + if x > 0 && y < 0 then quotInt32 (x-y-1) y + else if x < 0 && y > 0 then quotInt32 (x-y+1) y + else quotInt32 x y + quot x@(I32# _) y@(I32# y#) = + if y# /=# 0# + then x `quotInt32` y + else error "Integral.Int32.quot: divide by 0\n" + rem x@(I32# _) y@(I32# y#) = + if y# /=# 0# + then x `remInt32` y + else error "Integral.Int32.rem: divide by 0\n" + mod x@(I32# x#) y@(I32# y#) = + if x > 0 && y < 0 || x < 0 && y > 0 then + if r/=0 then r+y else 0 + else + r + where r = remInt32 x y + a@(I32# _) `quotRem` b@(I32# _) = (a `quotInt32` b, a `remInt32` b) + toInteger i32 = toInteger (int32ToInt i32) + toInt i32 = int32ToInt i32 + +remInt32 (I32# x) (I32# y) = I32# (intToInt32# ((int32ToInt# x) `remInt#` (int32ToInt# y))) +quotInt32 (I32# x) (I32# y) = I32# (intToInt32# ((int32ToInt# x) `quotInt#` (int32ToInt# y))) instance Ix Int32 where range (m,n) = [m..n] index b@(m,n) i - | inRange b i = from (i - m) - | otherwise = error "index: Index out of range" + | inRange b i = int32ToInt (i - m) + | otherwise = error (showString "Ix{Int32}.index: Index " . + showParen True (showsPrec 0 i) . + showString " out of range " $ + showParen True (showsPrec 0 b) "") inRange (m,n) i = m <= i && i <= n instance Enum Int32 where - toEnum = to - fromEnum = from + toEnum = intToInt32 + fromEnum = int32ToInt enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Int32)] enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int32)] where last = if d < c then minBound else maxBound instance Read Int32 where - readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ] + readsPrec p s = [ (intToInt32 x,r) | (x,r) <- readsPrec p s ] instance Show Int32 where - showsPrec p = showsPrec p . from + showsPrec p i32 = showsPrec p (int32ToInt i32) instance Bits Int32 where - x .&. y = to (binop (wordop and#) x y) - x .|. y = to (binop (wordop or# ) x y) - x `xor` y = to (binop (wordop xor#) x y) - complement x = x `xor` -1 - shift (I32 (I# x)) i@(I# i#) - | i > 0 = I32 (I# (iShiftL# x i#)) - | otherwise = I32 (I# (iShiftRA# x i#)) --- rotate - bit i = 1 `shift` i + (I32# x) .&. (I32# y) = I32# (word2Int# ((int2Word# x) `and#` (int2Word# y))) + (I32# x) .|. (I32# y) = I32# (word2Int# ((int2Word# x) `or#` (int2Word# y))) + (I32# x) `xor` (I32# y) = I32# (word2Int# ((int2Word# x) `xor#` (int2Word# y))) +#if WORD_SIZE_IN_BYTES > 4 + complement (I32# x) = I32# (word2Int# ((int2Word# x) `xor#` (int2Word# 0xffffffff#))) +#else + complement (I32# x) = I32# (word2Int# ((int2Word# x) `xor#` (int2Word# (negateInt# 1#)))) +#endif + shift (I32# x) i@(I# i#) + | i > 0 = I32# (intToInt32# (iShiftL# (int32ToInt# x) i#)) + | otherwise = I32# (intToInt32# (iShiftRA# (int32ToInt# x) i#)) + i32@(I32# x) `rotate` (I# i) + | i ==# 0# = i32 + | i ># 0# = + -- ( (x<>i2) + I32# (intToInt32# ( word2Int# ( + (int2Word# (iShiftL# (int32ToInt# x) i')) + `or#` + (int2Word# (iShiftRA# (word2Int# ( + (int2Word# x) + `and#` + (int2Word# (maxBound# -# pow2# i2 +# 1#)))) + i2))))) + | otherwise = rotate i32 (I# (32# +# i)) + where + i' = word2Int# (int2Word# i `and#` int2Word# 31#) + i2 = 32# -# i' + (I32# maxBound#) = maxBound + bit i = shift 1 i setBit x i = x .|. bit i clearBit x i = x .&. complement (bit i) complementBit x i = x `xor` bit i @@ -310,32 +487,6 @@ wordop op (I# x) (I# y) = I# (word2Int# (int2Word# x `op` int2Word# y)) ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- --- Coercions - used to make the instance declarations more uniform ------------------------------------------------------------------------------ - -class Coerce a where - to :: Int -> a - from :: a -> Int - -instance Coerce Int32 where - from = int32ToInt - to = intToInt32 - -instance Coerce Int8 where - from = int8ToInt - to = intToInt8 - -instance Coerce Int16 where - from = int16ToInt - to = intToInt16 - -binop :: Coerce int => (Int -> Int -> a) -> (int -> int -> a) -binop op x y = from x `op` from y - -to2 :: Coerce int => (Int, Int) -> (int, int) -to2 (x,y) = (to x, to y) - ------------------------------------------------------------------------------ -- Code copied from the Prelude ----------------------------------------------------------------------------- diff --git a/ghc/lib/glaExts/Word.lhs b/ghc/lib/glaExts/Word.lhs index f5cecf7..9e4f7dd 100644 --- a/ghc/lib/glaExts/Word.lhs +++ b/ghc/lib/glaExts/Word.lhs @@ -1,19 +1,23 @@ % -% (c) The AQUA Project, Glasgow University, 1994-1996 +% (c) The AQUA Project, Glasgow University, 1997 % - \section[Word]{Module @Word@} -This code is largely copied from the Hugs library of the same name. +GHC implementation of the standard Hugs/GHC @Word@ +interface, types and operations over unsigned, sized +quantities. \begin{code} {-# OPTIONS -fno-implicit-prelude #-} - module Word - ( Word8 - , Word16 - , Word32 - , Word64 + ( Word8 -- all abstract. + , Word16 -- instances: Eq, Ord + , Word32 -- Num, Bounded, Real, + , Word64 -- Integral, Ix, Enum, + -- Read, Show, Bits, + -- CCallable, CReturnable + -- (last two + , word8ToWord32 -- :: Word8 -> Word32 , word32ToWord8 -- :: Word32 -> Word8 , word16ToWord32 -- :: Word16 -> Word32 @@ -30,9 +34,10 @@ import PrelBase import PrelNum import PrelRead import Ix -import Error +import GHCerr ( error ) import Bits import GHC +import CCall ----------------------------------------------------------------------------- -- The "official" coercion functions @@ -55,56 +60,105 @@ intToWord16 = word32ToWord16 . intToWord32 intToWord32 (I# x) = W32# (int2Word# x) word32ToInt (W32# x) = I# (word2Int# x) +\end{code} ------------------------------------------------------------------------------ --- Word8 ------------------------------------------------------------------------------ - -newtype Word8 = W8 Word32 +\subsection[Word8]{The @Word8@ interface} -word8ToWord32 (W8 x) = x .&. 0xff -word32ToWord8 = W8 +The byte type @Word8@ is represented in the Haskell +heap by boxing up a 32-bit quantity, @Word#@. An invariant +for this representation is that the higher 24 bits are +*always* zeroed out. A consequence of this is that +operations that could possibly overflow have to mask +out the top three bytes before building the resulting @Word8@. -instance Eq Word8 where (==) = binop (==) -instance Ord Word8 where compare = binop compare +\begin{code} +data Word8 = W8# Word# + +instance CCallable Word8 +instance CReturnable Word8 + +word8ToWord32 (W8# x) = W32# x +word32ToWord8 (W32# x) = W8# (wordToWord8# x) + +-- mask out upper three bytes. +intToWord8# :: Int# -> Word# +intToWord8# i# = (int2Word# i#) `and#` (int2Word# 0xff#) + +wordToWord8# :: Word# -> Word# +wordToWord8# w# = w# `and#` (int2Word# 0xff#) + +instance Eq Word8 where + (W8# x) == (W8# y) = x `eqWord#` y + (W8# x) /= (W8# y) = x `neWord#` y + +instance Ord Word8 where + compare (W8# x#) (W8# y#) = compareWord# x# y# + (<) (W8# x) (W8# y) = x `ltWord#` y + (<=) (W8# x) (W8# y) = x `leWord#` y + (>=) (W8# x) (W8# y) = x `geWord#` y + (>) (W8# x) (W8# y) = x `gtWord#` y + max x@(W8# x#) y@(W8# y#) = + case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x } + min x@(W8# x#) y@(W8# y#) = + case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y } + +-- Helper function, used by Ord Word* instances. +compareWord# :: Word# -> Word# -> Ordering +compareWord# x# y# + | x# `ltWord#` y# = LT + | x# `eqWord#` y# = EQ + | otherwise = GT instance Num Word8 where - x + y = to (binop (+) x y) - x - y = to (binop (-) x y) - negate = to . negate . from - x * y = to (binop (*) x y) - abs x = x - signum = signumReal - fromInteger = to . integer2Word - fromInt = intToWord8 + (W8# x) + (W8# y) = + W8# (intToWord8# (word2Int# x +# word2Int# y)) + (W8# x) - (W8# y) = + W8# (intToWord8# (word2Int# x -# word2Int# y)) + (W8# x) * (W8# y) = + W8# (intToWord8# (word2Int# x *# word2Int# y)) + negate w@(W8# x) = + if x' ==# 0# + then w + else W8# (int2Word# (0x100# -# x')) + where + x' = word2Int# x + abs x = x + signum = signumReal + fromInteger (J# a# s# d#) = W8# (intToWord8# (integer2Int# a# s# d#)) + fromInt = intToWord8 instance Bounded Word8 where - minBound = 0 - maxBound = 0xff + minBound = 0 + maxBound = 0xff instance Real Word8 where - toRational x = toInteger x % 1 + toRational x = toInteger x % 1 +-- Note: no need to mask results here +-- as they cannot overflow. instance Integral Word8 where - x `div` y = to (binop div x y) - x `quot` y = to (binop quot x y) - x `rem` y = to (binop rem x y) - x `mod` y = to (binop mod x y) - x `quotRem` y = to2 (binop quotRem x y) - divMod = quotRem - toInteger = toInteger . from - toInt = word8ToInt + div (W8# x) (W8# y) = W8# (x `quotWord#` y) + quot (W8# x) (W8# y) = W8# (x `quotWord#` y) + rem (W8# x) (W8# y) = W8# (x `remWord#` y) + mod (W8# x) (W8# y) = W8# (x `remWord#` y) + quotRem (W8# x) (W8# y) = (W8# (x `quotWord#` y), W8# (x `remWord#` y)) + divMod (W8# x) (W8# y) = (W8# (x `quotWord#` y), W8# (x `remWord#` y)) + toInteger (W8# x) = word2Integer# x + toInt x = word8ToInt x instance Ix Word8 where range (m,n) = [m..n] index b@(m,n) i - | inRange b i = word32ToInt (from (i - m)) - | otherwise = error "index: Index out of range" + | inRange b i = word8ToInt (i-m) + | otherwise = error (showString "Ix{Word8}.index: Index " . + showParen True (showsPrec 0 i) . + showString " out of range " $ + showParen True (showsPrec 0 b) "") inRange (m,n) i = m <= i && i <= n instance Enum Word8 where - toEnum = to . intToWord32 - fromEnum = word32ToInt . from + toEnum (I# i) = W8# (intToWord8# i) + fromEnum (W8# w) = I# (word2Int# w) enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Word8)] enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word8)] where last = if d < c then minBound else maxBound @@ -115,70 +169,137 @@ instance Read Word8 where instance Show Word8 where showsPrec p = showInt +-- +-- Word8s are represented by an (unboxed) 32-bit Word. +-- The invariant is that the upper 24 bits are always zeroed out. +-- instance Bits Word8 where - x .&. y = to (binop (.&.) x y) - x .|. y = to (binop (.|.) x y) - x `xor` y = to (binop xor x y) - complement = to . complement . from - x `shift` i = to (from x `shift` i) --- rotate - bit = to . bit - setBit x i = to (setBit (from x) i) - clearBit x i = to (clearBit (from x) i) - complementBit x i = to (complementBit (from x) i) - testBit x i = testBit (from x) i + (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) + complement (W8# x) = W8# (x `xor#` int2Word# 0xff#) + shift (W8# x#) i@(I# i#) + | i > 0 = W8# (wordToWord8# (shiftL# x# i#)) + | otherwise = W8# (wordToWord8# (shiftRL# x# (negateInt# i#))) + w@(W8# x) `rotate` (I# i) + | i ==# 0# = w + | i ># 0# = W8# ((wordToWord8# (shiftL# x i')) `or#` + (shiftRL# (x `and#` + (int2Word# (0x100# -# pow2# i2))) + i2)) + | otherwise = rotate w (I# (8# +# i)) + where + i' = word2Int# (int2Word# i `and#` int2Word# 7#) + i2 = 8# -# i' + + bit (I# i#) + | i# >=# 0# && i# <=# 7# = W8# (wordToWord8# (shiftL# (int2Word# 1#) i#)) + | otherwise = 0 -- We'll be overbearing, for now.. + + setBit x i = x .|. bit i + clearBit x i = x .&. complement (bit i) + complementBit x i = x `xor` bit i + + testBit (W8# x#) (I# i#) + | i# <# 8# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0# + | otherwise = False -- for now, this is really an error. + bitSize _ = 8 isSigned _ = False ------------------------------------------------------------------------------ --- Word16 ------------------------------------------------------------------------------ +pow2# :: Int# -> Int# +pow2# x# = word2Int# (shiftL# (int2Word# 1#) x#) -newtype Word16 = W16 Word32 +\end{code} + +\subsection[Word16]{The @Word16@ interface} -word16ToWord32 (W16 x) = x .&. 0xffff -word32ToWord16 = W16 +The double byte type @Word16@ is represented in the Haskell +heap by boxing up a machine word, @Word#@. An invariant +for this representation is that only the lower 16 bits are +`active', any bits above are {\em always} zeroed out. +A consequence of this is that operations that could possibly +overflow have to mask out anything above the lower two bytes +before putting together the resulting @Word16@. -instance Eq Word16 where (==) = binop (==) -instance Ord Word16 where compare = binop compare +\begin{code} +data Word16 = W16# Word# +instance CCallable Word16 +instance CReturnable Word16 + +word16ToWord32 (W16# x) = W32# x +word32ToWord16 (W32# x) = W16# (wordToWord16# x) + +-- mask out upper 16 bits. +intToWord16# :: Int# -> Word# +intToWord16# i# = ((int2Word# i#) `and#` (int2Word# 0xffff#)) + +wordToWord16# :: Word# -> Word# +wordToWord16# w# = w# `and#` (int2Word# 0xffff#) + +instance Eq Word16 where + (W16# x) == (W16# y) = x `eqWord#` y + (W16# x) /= (W16# y) = x `neWord#` y + +instance Ord Word16 where + compare (W16# x#) (W16# y#) = compareWord# x# y# + (<) (W16# x) (W16# y) = x `ltWord#` y + (<=) (W16# x) (W16# y) = x `leWord#` y + (>=) (W16# x) (W16# y) = x `geWord#` y + (>) (W16# x) (W16# y) = x `gtWord#` y + max x@(W16# x#) y@(W16# y#) = + case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x } + min x@(W16# x#) y@(W16# y#) = + case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y } instance Num Word16 where - x + y = to (binop (+) x y) - x - y = to (binop (-) x y) - negate = to . negate . from - x * y = to (binop (*) x y) - abs x = x - signum = signumReal - fromInteger = to . integer2Word - fromInt = intToWord16 + (W16# x) + (W16# y) = + W16# (intToWord16# (word2Int# x +# word2Int# y)) + (W16# x) - (W16# y) = + W16# (intToWord16# (word2Int# x -# word2Int# y)) + (W16# x) * (W16# y) = + W16# (intToWord16# (word2Int# x *# word2Int# y)) + negate w@(W16# x) = + if x' ==# 0# + then w + else W16# (int2Word# (0x10000# -# x')) + where + x' = word2Int# x + abs x = x + signum = signumReal + fromInteger (J# a# s# d#) = W16# (intToWord16# (integer2Int# a# s# d#)) + fromInt = intToWord16 instance Bounded Word16 where - minBound = 0 - maxBound = 0xffff + minBound = 0 + maxBound = 0xffff instance Real Word16 where toRational x = toInteger x % 1 instance Integral Word16 where - x `div` y = to (binop div x y) - x `quot` y = to (binop quot x y) - x `rem` y = to (binop rem x y) - x `mod` y = to (binop mod x y) - x `quotRem` y = to2 (binop quotRem x y) - divMod = quotRem - toInteger = toInteger . from - toInt = word16ToInt + div (W16# x) (W16# y) = W16# (x `quotWord#` y) + quot (W16# x) (W16# y) = W16# (x `quotWord#` y) + rem (W16# x) (W16# y) = W16# (x `remWord#` y) + mod (W16# x) (W16# y) = W16# (x `remWord#` y) + quotRem (W16# x) (W16# y) = (W16# (x `quotWord#` y), W16# (x `remWord#` y)) + divMod (W16# x) (W16# y) = (W16# (x `quotWord#` y), W16# (x `remWord#` y)) + toInteger (W16# x) = word2Integer# x + toInt x = word16ToInt x instance Ix Word16 where range (m,n) = [m..n] index b@(m,n) i - | inRange b i = word32ToInt (from (i - m)) - | otherwise = error "index: Index out of range" + | inRange b i = word16ToInt (i - m) + | otherwise = error (showString "Ix{Word16}.index: Index " . + showParen True (showsPrec 0 i) . + showString " out of range " $ + showParen True (showsPrec 0 b) "") inRange (m,n) i = m <= i && i <= n instance Enum Word16 where - toEnum = to . intToWord32 - fromEnum = word32ToInt . from + toEnum (I# i) = W16# (intToWord16# i) + fromEnum (W16# w) = I# (word2Int# w) enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Word16)] enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word16)] where last = if d < c then minBound else maxBound @@ -190,75 +311,137 @@ instance Show Word16 where showsPrec p = showInt instance Bits Word16 where - x .&. y = to (binop (.&.) x y) - x .|. y = to (binop (.|.) x y) - x `xor` y = to (binop xor x y) - complement = to . complement . from - x `shift` i = to (from x `shift` i) --- rotate - bit = to . bit - setBit x i = to (setBit (from x) i) - clearBit x i = to (clearBit (from x) i) - complementBit x i = to (complementBit (from x) i) - testBit x i = testBit (from x) i + (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) + complement (W16# x) = W16# (x `xor#` int2Word# 0xffff#) + shift (W16# x#) i@(I# i#) + | i > 0 = W16# (wordToWord16# (shiftL# x# i#)) + | otherwise = W16# (shiftRL# x# (negateInt# i#)) + w@(W16# x) `rotate` (I# i) + | i ==# 0# = w + | i ># 0# = W16# ((wordToWord16# (shiftL# x i')) `or#` + (shiftRL# (x `and#` + (int2Word# (0x10000# -# pow2# i2))) + i2)) + | otherwise = rotate w (I# (16# +# i')) + where + i' = word2Int# (int2Word# i `and#` int2Word# 15#) + i2 = 16# -# i' + bit (I# i#) + | i# >=# 0# && i# <=# 15# = W16# (shiftL# (int2Word# 1#) i#) + | otherwise = 0 -- We'll be overbearing, for now.. + + setBit x i = x .|. bit i + clearBit x i = x .&. complement (bit i) + complementBit x i = x `xor` bit i + + testBit (W16# x#) (I# i#) + | i# <# 16# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0# + | otherwise = False -- for now, this is really an error. + bitSize _ = 16 isSigned _ = False ------------------------------------------------------------------------------ --- Word32 --- --- This code assumes that Word# is 32-bits - which is true on a 32-bit --- architecture, but will need to be updated for 64-bit architectures. ------------------------------------------------------------------------------ +\end{code} + +\subsection[Word32]{The @Word32@ interface} -data Word32 = W32# Word# deriving (Eq, Ord) +The quad byte type @Word32@ is represented in the Haskell +heap by boxing up a machine word, @Word#@. An invariant +for this representation is that any bits above the lower +32 are {\em always} zeroed out. A consequence of this is that +operations that could possibly overflow have to mask +the result before building the resulting @Word16@. + +\begin{code} +data Word32 = W32# Word# +instance CCallable Word32 +instance CReturnable Word32 + +instance Eq Word32 where + (W32# x) == (W32# y) = x `eqWord#` y + (W32# x) /= (W32# y) = x `neWord#` y + +instance Ord Word32 where + compare (W32# x#) (W32# y#) = compareWord# x# y# + (<) (W32# x) (W32# y) = x `ltWord#` y + (<=) (W32# x) (W32# y) = x `leWord#` y + (>=) (W32# x) (W32# y) = x `geWord#` y + (>) (W32# x) (W32# y) = x `gtWord#` y + max x@(W32# x#) y@(W32# y#) = + case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x } + min x@(W32# x#) y@(W32# y#) = + case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y } instance Num Word32 where - (+) = intop (+) - (-) = intop (-) - (*) = intop (*) - negate (W32# x) = W32# (int2Word# (negateInt# (word2Int# x))) - abs x = x - signum = signumReal - fromInteger = integer2Word - fromInt (I# x) = W32# (int2Word# x) - -{-# INLINE intop #-} -intop op x y = intToWord32 (word32ToInt x `op` word32ToInt y) + (W32# x) + (W32# y) = + W32# (intToWord32# (word2Int# x +# word2Int# y)) + (W32# x) - (W32# y) = + W32# (intToWord32# (word2Int# x -# word2Int# y)) + (W32# x) * (W32# y) = + W32# (intToWord32# (word2Int# x *# word2Int# y)) +#if WORD_SIZE_IN_BYTES > 4 + negate w@(W32# x) = + if x' ==# 0# + then w + else W32# (intToWord32# (0x100000000# -# x')) + where + x' = word2Int# x +#else + negate (W32# x) = W32# (intToWord32# (negateInt# (word2Int# x))) +#endif + abs x = x + signum = signumReal + fromInteger (J# a# s# d#) = W32# (intToWord32# (integer2Int# a# s# d#)) + fromInt (I# x) = W32# (intToWord32# x) + -- ToDo: restrict fromInt{eger} range. + +intToWord32# :: Int# -> Word# +wordToWord32# :: Word# -> Word# + +#if WORD_SIZE_IN_BYTES > 4 +intToWord32# i# = (int2Word# i#) `and#` (int2Word# 0xffffffff) +wordToWord32# w# = w# `and#` (int2Word# 0xffffffff) +#else +intToWord32# i# = int2Word# i# +wordToWord32# w# = w# +#endif instance Bounded Word32 where minBound = 0 +#if WORD_SIZE_IN_BYTES > 4 + maxBound = 0xffffffff +#else maxBound = minBound - 1 +#endif instance Real Word32 where toRational x = toInteger x % 1 instance Integral Word32 where - x `div` y = if x > 0 && y < 0 then quotWord (x-y-1) y - else if x < 0 && y > 0 then quotWord (x-y+1) y - else quotWord x y - quot = quotWord - rem = remWord - x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then - if r/=0 then r+y else 0 - else - r - where r = remWord x y - a `quotRem` b = (a `quot` b, a `rem` b) - divMod x y = (x `div` y, x `mod` y) - toInteger (W32# x) = int2Integer# (word2Int# x) + div x y = quotWord32 x y + quot x y = quotWord32 x y + rem x y = remWord32 x y + mod x y = remWord32 x y + quotRem a b = (a `quotWord32` b, a `remWord32` b) + divMod x y = quotRem x y + toInteger (W32# x) = word2Integer# x toInt (W32# x) = I# (word2Int# x) -{-# INLINE quotWord #-} -{-# INLINE remWord #-} -(W32# x) `quotWord` (W32# y) = W32# (x `quotWord#` y) -(W32# x) `remWord` (W32# y) = W32# (x `remWord#` y) +{-# INLINE quotWord32 #-} +{-# INLINE remWord32 #-} +(W32# x) `quotWord32` (W32# y) = W32# (x `quotWord#` y) +(W32# x) `remWord32` (W32# y) = W32# (x `remWord#` y) instance Ix Word32 where range (m,n) = [m..n] index b@(m,n) i | inRange b i = word32ToInt (i - m) - | otherwise = error "index: Index out of range" + | otherwise = error (showString "Ix{Word32}.index: Index " . + showParen True (showsPrec 0 i) . + showString " out of range " $ + showParen True (showsPrec 0 b) "") inRange (m,n) i = m <= i && i <= n instance Enum Word32 where @@ -275,29 +458,44 @@ instance Show Word32 where showsPrec p = showInt instance Bits Word32 where - (.&.) = wordop and# - (.|.) = wordop or# - xor = wordop xor# - complement x = x `xor` maxBound + (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) + complement (W32# x) = W32# (x `xor#` mb#) where (W32# mb#) = maxBound shift (W32# x) i@(I# i#) - | i > 0 = W32# (shiftL# x i#) - | otherwise = W32# (shiftRA# x (negateInt# i#)) - --rotate - bit i = 1 `shift` i + | i > 0 = W32# (wordToWord32# (shiftL# x i#)) + | otherwise = W32# (shiftRL# x (negateInt# i#)) + w@(W32# x) `rotate` (I# i) + | i ==# 0# = w + | i ># 0# = W32# ((wordToWord32# (shiftL# x i')) `or#` + (shiftRL# (x `and#` + (int2Word# (word2Int# maxBound# -# pow2# i2 +# 1#))) + i2)) + | otherwise = rotate w (I# (32# +# i)) + where + i' = word2Int# (int2Word# i `and#` int2Word# 31#) + i2 = 32# -# i' + (W32# maxBound#) = maxBound + + bit (I# i#) + | i# >=# 0# && i# <=# 31# = W32# (shiftL# (int2Word# 1#) i#) + | otherwise = 0 -- We'll be overbearing, for now.. + 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 + + testBit (W32# x#) (I# i#) + | i# <# 32# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0# + | otherwise = False -- for now, this is really an error. bitSize _ = 32 isSigned _ = False -{-# INLINE wordop #-} -wordop op (W32# x) (W32# y) = W32# (x `op` y) +\end{code} ------------------------------------------------------------------------------ --- Word64 ------------------------------------------------------------------------------ +\subsection[Word64]{The @Word64@ interface} +\begin{code} data Word64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded) w64ToInteger W64{lo,hi} = toInteger lo + 0x100000000 * toInteger hi @@ -318,30 +516,6 @@ instance Read Word64 where ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- --- Coercions - used to make the instance declarations more uniform ------------------------------------------------------------------------------ - -class Coerce a where - to :: Word32 -> a - from :: a -> Word32 - -instance Coerce Word8 where - from = word8ToWord32 - to = word32ToWord8 - -instance Coerce Word16 where - from = word16ToWord32 - to = word32ToWord16 - -binop :: Coerce word => (Word32 -> Word32 -> a) -> (word -> word -> a) -binop op x y = from x `op` from y - -to2 :: Coerce word => (Word32, Word32) -> (word, word) -to2 (x,y) = (to x, to y) - -integer2Word (J# a# s# d#) = W32# (int2Word# (integer2Int# a# s# d#)) - ------------------------------------------------------------------------------ -- Code copied from the Prelude ----------------------------------------------------------------------------- -- 1.7.10.4