From 31518c3eaa85307df22ebfdf0fb24dcb04694f3f Mon Sep 17 00:00:00 2001 From: andy Date: Wed, 10 Nov 1999 23:26:57 +0000 Subject: [PATCH] [project @ 1999-11-10 23:26:57 by andy] Adding Int8,16,32,64 into Hugs. These changes are based on the current (Sep99 Hugs) version of Word. The GHC parts should be unchanged. --- ghc/lib/exts/Int.lhs | 403 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 399 insertions(+), 4 deletions(-) diff --git a/ghc/lib/exts/Int.lhs b/ghc/lib/exts/Int.lhs index ff8a4df..3a738fc 100644 --- a/ghc/lib/exts/Int.lhs +++ b/ghc/lib/exts/Int.lhs @@ -55,6 +55,7 @@ module Int -- plus Eq, Ord, Num, Bounded, Real, Integral, Ix, Enum, Read, -- Show and Bits instances for each of Int8, Int16, Int32 and Int64 +#ifndef __HUGS__ -- The "official" place to get these from is Addr, importing -- them from Int is a non-standard thing to do. , indexInt8OffAddr @@ -71,6 +72,8 @@ module Int , writeInt16OffAddr , writeInt32OffAddr , writeInt64OffAddr + +#endif , sizeofInt8 , sizeofInt16 @@ -79,6 +82,7 @@ module Int -- The "official" place to get these from is Foreign #ifndef __PARALLEL_HASKELL__ +#ifndef __HUGS__ , indexInt8OffForeignObj , indexInt16OffForeignObj , indexInt32OffForeignObj @@ -94,6 +98,7 @@ module Int , writeInt32OffForeignObj , writeInt64OffForeignObj #endif +#endif -- The non-standard fromInt and toInt methods , Num( fromInt ), Integral( toInt ) @@ -101,29 +106,35 @@ module Int -- non-standard, GHC specific , intToWord +#ifndef __HUGS__ -- Internal, do not use. , int8ToInt# , int16ToInt# , int32ToInt# +#endif ) where -#ifdef __HUGS__ -import PreludeBuiltin -#else +#ifndef __HUGS__ import PrelBase import CCall import PrelForeign import PrelIOBase import PrelAddr ( Int64(..), Word64(..), Addr(..), Word(..) ) +import PrelNum ( Num(..), Integral(..) ) -- To get fromInt/toInt +#else +import Word #endif import Ix import Bits -import PrelNum ( Num(..), Integral(..) ) -- To get fromInt/toInt import Ratio ( (%) ) import Numeric ( readDec ) import Word ( Word32 ) +\end{code} +#ifndef __HUGS__ + +\begin{code} ----------------------------------------------------------------------------- -- The "official" coercion functions ----------------------------------------------------------------------------- @@ -1323,3 +1334,387 @@ divZeroError meth v = error ("Integral." ++ meth ++ ": divide by 0 (" ++ show v ++ " / 0)") \end{code} + +#else +\begin{code} +----------------------------------------------------------------------------- +-- The "official" coercion functions +----------------------------------------------------------------------------- + +int8ToInt :: Int8 -> Int +intToInt8 :: Int -> Int8 +int16ToInt :: Int16 -> Int +intToInt16 :: Int -> Int16 +int32ToInt :: Int32 -> Int +intToInt32 :: Int -> Int32 + +-- And some non-exported ones + +int8ToInt16 :: Int8 -> Int16 +int8ToInt32 :: Int8 -> Int32 +int16ToInt8 :: Int16 -> Int8 +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 + +----------------------------------------------------------------------------- +-- Int8 +----------------------------------------------------------------------------- + +newtype Int8 = I8 Int + +int8ToInt (I8 x) = if x' <= 0x7f then x' else x' - 0x100 + where x' = x `primAndInt` 0xff +intToInt8 = I8 + +instance Eq Int8 where (==) = binop (==) +instance Ord Int8 where compare = binop compare + +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 + +instance Bounded Int8 where + minBound = 0x80 + maxBound = 0x7f + +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) + even = even . from + toInteger = toInteger . from + toInt = toInt . from + +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 (m,n) i = m <= i && i <= n + +instance Enum Int8 where + toEnum = to + fromEnum = from + 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 ] + +instance Show Int8 where + showsPrec p = showsPrec p . from + +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 + bitSize _ = 8 + isSigned _ = True + +int8ToInteger = error "TODO: int8ToInteger" +integerToInt8 = error "TODO: integerToInt8" + +--intToInt8 = fromInt +--int8ToInt = toInt + +sizeofInt8 :: Word32 +sizeofInt8 = 1 + +----------------------------------------------------------------------------- +-- Int16 +----------------------------------------------------------------------------- + +newtype Int16 = I16 Int + +int16ToInt (I16 x) = if x' <= 0x7fff then x' else x' - 0x10000 + where x' = x `primAndInt` 0xffff +intToInt16 = I16 + +instance Eq Int16 where (==) = binop (==) +instance Ord Int16 where compare = binop compare + +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 + +instance Bounded Int16 where + minBound = 0x8000 + maxBound = 0x7fff + +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) + even = even . from + toInteger = toInteger . from + toInt = toInt . from + +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 (m,n) i = m <= i && i <= n + +instance Enum Int16 where + toEnum = to + fromEnum = from + 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 ] + +instance Show Int16 where + showsPrec p = showsPrec p . from + +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 + +int16ToInteger = error "TODO: int16ToInteger" +integerToInt16 = error "TODO: integerToInt16" + +--intToInt16 = fromInt +--int16ToInt = toInt + +sizeofInt16 :: Word32 +sizeofInt16 = 2 + +----------------------------------------------------------------------------- +-- Int32 +----------------------------------------------------------------------------- + +newtype Int32 = I32 Int + +int32ToInt (I32 x) = x +intToInt32 = I32 + +instance Eq Int32 where (==) = binop (==) +instance Ord Int32 where compare = binop compare + +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 + +instance Bounded Int32 where + minBound = to minBound + maxBound = to maxBound + +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) + even = even . from + toInteger = toInteger . from + toInt = toInt . from + +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 (m,n) i = m <= i && i <= n + +instance Enum Int32 where + toEnum = to + fromEnum = from + 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 ] + +instance Show Int32 where + showsPrec p = showsPrec p . from + +instance Bits Int32 where + (.&.) x y = to (binop primAndInt x y) + (.|.) x y = to (binop primOrInt x y) + xor x y = to (binop primXorInt x y) + + complement = xor ((-1) :: Int32) + x `shift` i | i == 0 = x + | i > 0 = to (primShiftLInt (from x) i) + | i < 0 = to (primShiftRAInt (from x) (-i)) +-- rotate + bit = shift 0x1 + setBit x i = x .|. bit i + clearBit x i = x .&. complement (bit i) + complementBit x i = x `xor` bit i + + testBit x i = (0x1 .&. shift x i) == (0x1 :: Int32) + bitSize _ = 32 + isSigned _ = True + + +int32ToInteger = error "TODO: int32ToInteger" +integerToInt32 = error "TODO: integerToInt32" + +sizeofInt32 :: Word32 +sizeofInt32 = 4 + +----------------------------------------------------------------------------- +-- Int64 +-- +-- This is not ideal, but does have the advantage that you can +-- now typecheck generated code that include Int64 statements. +-- +----------------------------------------------------------------------------- + +type Int64 = Integer + +int64ToInteger = error "TODO: int64ToInteger" + +integerToInt64 = error "TODO: integerToInt64" + +int64ToInt32 = error "TODO: int64ToInt32" +int64ToInt16 = error "TODO: int64ToInt16" +int64ToInt8 = error "TODO: int64ToInt8" + +int32ToInt64 = error "TODO: int32ToInt64" +int16ToInt64 = error "TODO: int16ToInt64" +int8ToInt64 = error "TODO: int8ToInt64" + +intToInt64 = fromInt +int64ToInt = toInt + +sizeofInt64 :: Word32 +sizeofInt64 = 8 + +----------------------------------------------------------------------------- +-- End of exported definitions +-- +-- The remainder of this file consists of definitions which are only +-- used in the implementation. +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- +-- 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) + +----------------------------------------------------------------------------- +-- Extra primitives +----------------------------------------------------------------------------- + +--primitive primAnd "primAndInt" :: Int -> Int -> Int + +--primitive primAndInt :: Int32 -> Int32 -> Int32 +--primitive primOrInt :: Int32 -> Int32 -> Int32 +--primitive primXorInt :: Int32 -> Int32 -> Int32 +--primitive primComplementInt :: Int32 -> Int32 +--primitive primShiftInt :: Int32 -> Int -> Int32 +--primitive primBitInt :: Int -> Int32 +--primitive primTestInt :: Int32 -> Int -> Bool + +----------------------------------------------------------------------------- +-- Code copied from the Prelude +----------------------------------------------------------------------------- + +absReal x | x >= 0 = x + | otherwise = -x + +signumReal x | x == 0 = 0 + | x > 0 = 1 + | otherwise = -1 + +----------------------------------------------------------------------------- +-- End +----------------------------------------------------------------------------- + +intToWord :: Int -> Word +intToWord i = primIntToWord i + +\end{code} +#endif -- 1.7.10.4