diff --git a/ghc/lib/exts/ByteArray.lhs b/ghc/lib/exts/ByteArray.lhs
index f7db46770b4ae1906c99c32a97fcea1899c556cb..6fba8e150bdef72a087118a71152c35edadda9bc 100644
--- a/ghc/lib/exts/ByteArray.lhs
+++ b/ghc/lib/exts/ByteArray.lhs
@@ -13,12 +13,12 @@ module ByteArray
Ix,
--Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
- indexCharArray, --:: Ix ix => ByteArray ix -> ix -> Char
- indexIntArray, --:: Ix ix => ByteArray ix -> ix -> Int
- indexWordArray, --:: Ix ix => ByteArray ix -> ix -> Word
- indexAddrArray, --:: Ix ix => ByteArray ix -> ix -> Addr
- indexFloatArray, --:: Ix ix => ByteArray ix -> ix -> Float
- indexDoubleArray, --:: Ix ix => ByteArray ix -> ix -> Double
+ indexCharArray, -- :: Ix ix => ByteArray ix -> ix -> Char
+ indexIntArray, -- :: Ix ix => ByteArray ix -> ix -> Int
+ indexWordArray, -- :: Ix ix => ByteArray ix -> ix -> Word
+ indexAddrArray, -- :: Ix ix => ByteArray ix -> ix -> Addr
+ indexFloatArray, -- :: Ix ix => ByteArray ix -> ix -> Float
+ indexDoubleArray, -- :: Ix ix => ByteArray ix -> ix -> Double
) where
diff --git a/ghc/lib/exts/Dynamic.lhs b/ghc/lib/exts/Dynamic.lhs
index 92a1725d31c5f856d41370e779b1e79bbc7a7cf7..c57b013ea2145460431489aec08aca4d96204f98 100644
--- a/ghc/lib/exts/Dynamic.lhs
+++ b/ghc/lib/exts/Dynamic.lhs
@@ -15,6 +15,8 @@ with operations for converting dynamic values into a concrete
The Dynamic implementation provided is closely based on code
contained in Hugs library of the same name.
+NOTE: test code at the end, but commented out.
+
\begin{code}
module Dynamic
(
@@ -116,9 +118,14 @@ instance Show TypeRep where
case tys of
[] -> showsPrec p tycon
[x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
- xs | isTupleTyCon tycon -> showTuple tycon xs
- xs -> showParen (p > 9) $
- showsPrec p tycon . showChar ' ' . showArgs tys
+ xs
+ | isTupleTyCon tycon -> showTuple tycon xs
+ | otherwise ->
+ showParen (p > 9) $
+ showsPrec p tycon .
+ showChar ' ' .
+ showArgs tys
+
showsPrec p (Fun f a) =
showParen (p > 8) $
showsPrec 9 f . showString " -> " . showsPrec 8 a
@@ -144,7 +151,7 @@ isTupleTyCon (TyCon _ (',':_)) = True
isTupleTyCon _ = False
instance Show TyCon where
- showsPrec d (TyCon _ s) = showString s
+ showsPrec _ (TyCon _ s) = showString s
--
-- If we enforce the restriction that TyCons are
@@ -164,6 +171,7 @@ uni = unsafePerformIO ( newIORef 0 )
Some (Show.TypeRep) helpers:
\begin{code}
+showArgs :: Show a => [a] -> ShowS
showArgs [] = id
showArgs [a] = showsPrec 10 a
showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as
@@ -357,16 +365,23 @@ instance ( Typeable a
\begin{code}
-- prelude types:
+intTc, charTc, boolTc :: TyCon
intTc = mkTyCon "Int"
charTc = mkTyCon "Char"
boolTc = mkTyCon "Bool"
+
+floatTc, doubleTc, integerTc :: TyCon
floatTc = mkTyCon "Float"
doubleTc = mkTyCon "Double"
integerTc = mkTyCon "Integer"
+
+ioTc, maybeTc, eitherTc, listTc :: TyCon
ioTc = mkTyCon "IO"
maybeTc = mkTyCon "Maybe"
eitherTc = mkTyCon "Either"
listTc = mkTyCon "[]"
+
+unitTc, orderingTc, arrayTc, complexTc, handleTc :: TyCon
unitTc = mkTyCon "()"
orderingTc = mkTyCon "Ordering"
arrayTc = mkTyCon "Array"
@@ -374,25 +389,35 @@ complexTc = mkTyCon "Complex"
handleTc = mkTyCon "Handle"
-- Hugs/GHC extension lib types:
+addrTc, stablePtrTc, mvarTc :: TyCon
addrTc = mkTyCon "Addr"
stablePtrTc = mkTyCon "StablePtr"
mvarTc = mkTyCon "MVar"
+
+foreignObjTc, stTc :: TyCon
foreignObjTc = mkTyCon "ForeignObj"
stTc = mkTyCon "ST"
+
+int8Tc, int16Tc, int32Tc, int64Tc :: TyCon
int8Tc = mkTyCon "Int8"
int16Tc = mkTyCon "Int16"
int32Tc = mkTyCon "Int32"
int64Tc = mkTyCon "Int64"
+
+word8Tc, word16Tc, word32Tc, word64Tc :: TyCon
word8Tc = mkTyCon "Word8"
word16Tc = mkTyCon "Word16"
word32Tc = mkTyCon "Word32"
word64Tc = mkTyCon "Word64"
+
+tyConTc, typeRepTc, dynamicTc :: TyCon
tyConTc = mkTyCon "TyCon"
typeRepTc = mkTyCon "Type"
dynamicTc = mkTyCon "Dynamic"
-- GHC specific:
{- BEGIN_FOR_GHC
+byteArrayTc, mutablebyteArrayTc, wordTc :: TyCon
byteArrayTc = mkTyCon "ByteArray"
mutablebyteArrayTc = mkTyCon "MutableByteArray"
wordTc = mkTyCon "Word"
@@ -400,7 +425,9 @@ wordTc = mkTyCon "Word"
\end{code}
-\begin{code}
+begin{code}
+test1,test2, test3, test4 :: Dynamic
+
test1 = toDyn (1::Int)
test2 = toDyn ((+) :: Int -> Int -> Int)
test3 = dynApp test2 test1
@@ -411,7 +438,9 @@ test5 = fromDyn test4 0
test6 = fromDyn test1 0
test7 = fromDyn test2 0
+test8 :: Dynamic
test8 = toDyn (mkAppTy listTc)
+
test9 :: Float
test9 = fromDyn test8 0
@@ -429,4 +458,4 @@ printf str args = putStr (decode str args)
test10 :: IO ()
test10 = printf "%n = %c, that much is %b\n" [toDyn (3::Int),toDyn 'a', toDyn False]
-\end{code}
+end{code}
diff --git a/ghc/lib/exts/Exception.lhs b/ghc/lib/exts/Exception.lhs
index d9f5fee0fa88bfdc3e38cfed6aeff5e80c6e2723..f9f7e71b4dcd1527477befd1d4193c95e23adda2 100644
--- a/ghc/lib/exts/Exception.lhs
+++ b/ghc/lib/exts/Exception.lhs
@@ -1,5 +1,5 @@
% -----------------------------------------------------------------------------
-% $Id: Exception.lhs,v 1.3 1999/01/07 16:39:07 simonm Exp $
+% $Id: Exception.lhs,v 1.4 1999/01/14 18:15:29 sof Exp $
%
% (c) The GRAP/AQUA Project, Glasgow University, 1998
%
@@ -105,14 +105,14 @@ tryAll a = catch# (a `seq` return (Right a)) (\e -> return (Left e))
#endif
tryAllIO :: IO a -> IO (Either Exception a)
-tryAllIO a = catchAllIO (a >>= \a -> return (Right a))
+tryAllIO a = catchAllIO (a >>= \ v -> return (Right v))
(\e -> return (Left e))
try :: (Exception -> Maybe b) -> a -> IO (Either b a)
try p a = do
r <- tryAll a
case r of
- Right a -> return (Right a)
+ Right v -> return (Right v)
Left e -> case p e of
Nothing -> throw e
Just b -> return (Left b)
@@ -121,7 +121,7 @@ tryIO :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
tryIO p a = do
r <- tryAllIO a
case r of
- Right a -> return (Right a)
+ Right v -> return (Right v)
Left e -> case p e of
Nothing -> throw e
Just b -> return (Left b)
@@ -150,7 +150,7 @@ catchDyn m k = catchException m handle
case fromDynamic dyn of
Just exception -> k exception
Nothing -> throw ex
- other -> throw ex
+ _ -> throw ex
\end{code}
-----------------------------------------------------------------------------
diff --git a/ghc/lib/exts/Foreign.lhs b/ghc/lib/exts/Foreign.lhs
index 23168a8b3ac886abc2bd15344c55fdb42c5eaee7..2187d5303e25d263d15308ad7609471906d4e459 100644
--- a/ghc/lib/exts/Foreign.lhs
+++ b/ghc/lib/exts/Foreign.lhs
@@ -21,7 +21,8 @@ module Foreign
, freeStablePtr -- :: StablePtr a -> IO ()
) where
-import PrelForeign
+import PrelForeign --hiding ( makeForeignObj )
+--import qualified PrelForeign as PF ( makeForeignObj )
import PrelBase ( Int(..), Double(..), Float(..), Char(..) )
import PrelGHC ( indexCharOffForeignObj#, indexIntOffForeignObj#,
indexAddrOffForeignObj#, indexFloatOffForeignObj#,
@@ -68,6 +69,17 @@ foreignObjToAddr :: ForeignObj -> IO Addr
foreignObjToAddr fo = _casm_ `` %r=(StgAddr)%0; '' fo
\end{code}
+begin{code}
+makeForeignObj :: Addr -> Addr -> IO ForeignObj
+makeForeignObj obj finaliser = do
+ fobj <- PF.makeForeignObj obj
+ addForeignFinaliser fobj (app0 finaliser)
+ return fobj
+
+foreign import dynamic unsafe app0 :: Addr -> IO ()
+end{code}
+
+
\begin{code}
indexCharOffForeignObj :: ForeignObj -> Int -> Char
diff --git a/ghc/lib/exts/GetOpt.lhs b/ghc/lib/exts/GetOpt.lhs
index d0bb8170b7129527b20c5a31fb35f5416a586db8..f8c4646953107ffdd24f70b3183d57c4b6561c1d 100644
--- a/ghc/lib/exts/GetOpt.lhs
+++ b/ghc/lib/exts/GetOpt.lhs
@@ -55,12 +55,12 @@ usageInfo header optDescr = unlines (header:table)
flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]
fmtOpt :: OptDescr a -> (String,String,String)
-fmtOpt (Option sos los ad descr) = (sepBy ", " (map (fmtShort ad) sos),
- sepBy ", " (map (fmtLong ad) los),
+fmtOpt (Option sos los ad descr) = (sepBy ',' (map (fmtShort ad) sos),
+ sepBy ',' (map (fmtLong ad) los),
descr)
- where sepBy sep [] = ""
- sepBy sep [x] = x
- sepBy sep (x:xs) = x ++ sep ++ sepBy sep xs
+ where sepBy _ [] = ""
+ sepBy _ [x] = x
+ sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs
fmtShort :: ArgDescr a -> Char -> String
fmtShort (NoArg _ ) so = "-" ++ [so]
@@ -99,16 +99,16 @@ getNext a rest _ = (NonOpt a,rest)
-- handle long option
longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
-longOpt xs rest optDescr = long ads arg rest
- where (opt,arg) = break (=='=') xs
+longOpt ls rs optDescr = long ads arg rs
+ where (opt,arg) = break (=='=') ls
options = [ o | o@(Option _ ls _ _) <- optDescr, l <- ls, opt `isPrefixOf` l ]
ads = [ ad | Option _ _ ad _ <- options ]
optStr = ("--"++opt)
long (_:_:_) _ rest = (errAmbig options optStr,rest)
long [NoArg a ] [] rest = (Opt a,rest)
- long [NoArg a ] ('=':xs) rest = (errNoArg optStr,rest)
- long [ReqArg f d] [] [] = (errReq d optStr,[])
+ long [NoArg _ ] ('=':_) rest = (errNoArg optStr,rest)
+ long [ReqArg _ d] [] [] = (errReq d optStr,[])
long [ReqArg f _] [] (r:rest) = (Opt (f r),rest)
long [ReqArg f _] ('=':xs) rest = (Opt (f xs),rest)
long [OptArg f _] [] rest = (Opt (f Nothing),rest)
diff --git a/ghc/lib/exts/GlaExts.lhs b/ghc/lib/exts/GlaExts.lhs
index 0bc59acc75f53088af6da2a58344b50081fa9f33..2a673e286547e093e062803b64dd2d4f48ec8728 100644
--- a/ghc/lib/exts/GlaExts.lhs
+++ b/ghc/lib/exts/GlaExts.lhs
@@ -52,7 +52,6 @@ module GlaExts
-- misc bits
trace,
- Lift(..),
-- and finally, all the unboxed primops of PrelGHC!
module PrelGHC
@@ -70,9 +69,16 @@ import MutableArray
import Monad
type PrimIO a = IO a
+
+primIOToIO :: PrimIO a -> IO a
primIOToIO io = io
+
+ioToPrimIO :: IO a -> PrimIO a
ioToPrimIO io = io
+
+unsafePerformPrimIO :: PrimIO a -> a
unsafePerformPrimIO = unsafePerformIO
+
thenPrimIO :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
thenPrimIO = (>>=)
diff --git a/ghc/lib/exts/IOExts.lhs b/ghc/lib/exts/IOExts.lhs
index 50463566320c9db788f5ad0ba5886c6da55560a6..5bbd8f0dffac3469c30a568e0d3268b1f9a2715d 100644
--- a/ghc/lib/exts/IOExts.lhs
+++ b/ghc/lib/exts/IOExts.lhs
@@ -49,6 +49,7 @@ module IOExts
, unsafePtrEq
, unsafeIOToST
+ , stToIO
) where
diff --git a/ghc/lib/exts/Int.lhs b/ghc/lib/exts/Int.lhs
index 6b40fe22c6718bf14a5016a71b54d96d50f20f2b..046821666bbbedf1229ca55763e2d3684315fb27 100644
--- a/ghc/lib/exts/Int.lhs
+++ b/ghc/lib/exts/Int.lhs
@@ -87,6 +87,7 @@ import PrelAddr ( Int64(..), Word64(..) )
#endif
import Ix
import Bits
+import Ratio ( (%) )
import Numeric ( readDec )
import Word ( Word32 )
@@ -130,6 +131,8 @@ instance CCallable Int8
instance CReturnable Int8
int8ToInt (I8# x) = I# (int8ToInt# x)
+
+int8ToInt# :: Int# -> Int#
int8ToInt# x = if x' <=# 0x7f# then x' else x' -# 0x100#
where x' = word2Int# (int2Word# x `and#` int2Word# 0xff#)
@@ -139,6 +142,8 @@ int8ToInt# x = if x' <=# 0x7f# then x' else x' -# 0x100#
-- i.e., show (intToInt8 511) => "-1"
--
intToInt8 (I# x) = I8# (intToInt8# x)
+
+intToInt8# :: Int# -> Int#
intToInt8# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xff#)
instance Eq Int8 where
@@ -177,40 +182,45 @@ instance Real Int8 where
toRational x = toInteger x % 1
instance Integral Int8 where
- 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
+ div x y
+ | x > 0 && y < 0 = quotInt8 (x-y-1) y
+ | x < 0 && y > 0 = quotInt8 (x-y+1) y
+ | otherwise = quotInt8 x y
+
quot x@(I8# _) y@(I8# y#)
| y# /=# 0# = x `quotInt8` y
| otherwise = error "Integral.Int8.quot: divide by 0\n"
rem x@(I8# _) y@(I8# y#)
| y# /=# 0# = x `remInt8` y
| otherwise = 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
+ mod x y
+ | x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
+ | otherwise = 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, quotInt8 :: Int8 -> Int8 -> Int8
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
+ index b@(m,_) i
| 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) "")
+ | otherwise = indexError i b "Int8"
inRange (m,n) i = m <= i && i <= n
instance Enum Int8 where
+ succ i
+ | i == maxBound = error ("Enum{Int8}.succ: tried to take `succ' of " ++ show i)
+ | otherwise = i+1
+ pred i
+ | i == minBound = error ("Enum{Int8}.pred: tried to take `pred' of " ++ show i)
+ | otherwise = i+1
+
toEnum = intToInt8
fromEnum = int8ToInt
enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Int8)]
@@ -275,10 +285,13 @@ instance CReturnable Int16
int16ToInt (I16# x) = I# (int16ToInt# x)
+int16ToInt# :: Int# -> Int#
int16ToInt# x = if x' <=# 0x7fff# then x' else x' -# 0x10000#
where x' = word2Int# (int2Word# x `and#` int2Word# 0xffff#)
intToInt16 (I# x) = I16# (intToInt16# x)
+
+intToInt16# :: Int# -> Int#
intToInt16# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xffff#)
instance Eq Int16 where
@@ -310,40 +323,45 @@ instance Real Int16 where
toRational x = toInteger x % 1
instance Integral Int16 where
- 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
+ div x y
+ | x > 0 && y < 0 = quotInt16 (x-y-1) y
+ | x < 0 && y > 0 = quotInt16 (x-y+1) y
+ | otherwise = quotInt16 x y
+
quot x@(I16# _) y@(I16# y#)
| y# /=# 0# = x `quotInt16` y
| otherwise = error "Integral.Int16.quot: divide by 0\n"
rem x@(I16# _) y@(I16# y#)
| y# /=# 0# = x `remInt16` y
| otherwise = 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
+ mod x y
+ | x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
+ | otherwise = 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, quotInt16 :: Int16 -> Int16 -> Int16
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
+ index b@(m,_) i
| 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) "")
+ | otherwise = indexError i b "Int16"
inRange (m,n) i = m <= i && i <= n
instance Enum Int16 where
+ succ i
+ | i == maxBound = error ("Enum{Int16}.succ: tried to take `succ' of " ++ show i)
+ | otherwise = i+1
+ pred i
+ | i == minBound = error ("Enum{Int16}.pred: tried to take `pred' of " ++ show i)
+ | otherwise = i+1
+
toEnum = intToInt16
fromEnum = int16ToInt
enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Int16)]
@@ -456,40 +474,44 @@ instance Real Int32 where
toRational x = toInteger x % 1
instance Integral Int32 where
- 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
+ div x y
+ | x > 0 && y < 0 = quotInt32 (x-y-1) y
+ | x < 0 && y > 0 = quotInt32 (x-y+1) y
+ | otherwise = quotInt32 x y
quot x@(I32# _) y@(I32# y#)
| y# /=# 0# = x `quotInt32` y
| otherwise = error "Integral.Int32.quot: divide by 0\n"
rem x@(I32# _) y@(I32# y#)
| y# /=# 0# = x `remInt32` y
| otherwise = 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
+ mod x y
+ | x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
+ | otherwise = 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, quotInt32 :: Int32 -> Int32 -> Int32
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
+ index b@(m,_) i
| 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) "")
+ | otherwise = indexError i b "Int32"
inRange (m,n) i = m <= i && i <= n
instance Enum Int32 where
+ succ i
+ | i == maxBound = error ("Enum{Int32}.succ: tried to take `succ' of " ++ show i)
+ | otherwise = i+1
+ pred i
+ | i == minBound = error ("Enum{Int32}.pred: tried to take `pred' of " ++ show i)
+ | otherwise = i+1
+
toEnum = intToInt32
fromEnum = int32ToInt
enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Int32)]
@@ -584,7 +606,7 @@ instance Real Int64 where
toRational x = toInteger x % 1
instance Integral Int64 where
- div x@(I64# x#) y@(I64# y#)
+ div x y
| x > 0 && y < 0 = quotInt64 (x-y-1) y
| x < 0 && y > 0 = quotInt64 (x-y+1) y
| otherwise = quotInt64 x y
@@ -597,7 +619,7 @@ instance Integral Int64 where
| y# /=# 0# = x `remInt64` y
| otherwise = error "Integral.Int32.rem: divide by 0\n"
- mod x@(I64# x#) y@(I64# y#)
+ mod x y
| x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
| otherwise = r
where r = remInt64 x y
@@ -607,6 +629,13 @@ instance Integral Int64 where
toInt (I64# i#) = I# i#
instance Enum Int64 where
+ succ i
+ | i == maxBound = error ("Enum{Int64}.succ: tried to take `succ' of " ++ show i)
+ | otherwise = i+1
+ pred i
+ | i == minBound = error ("Enum{Int64}.pred: tried to take `pred' of " ++ show i)
+ | otherwise = i+1
+
toEnum (I# i) = I64# i#
fromEnum (I64# i) = I64# i#
enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Int64)] -- a long list!
@@ -692,7 +721,7 @@ instance Show Int64 where
showsPrec p x = showsPrec p (int64ToInteger x)
instance Read Int64 where
- readsPrec p s = [ (integerToInt64 x,r) | (x,r) <- readDec s ]
+ readsPrec _ s = [ (integerToInt64 x,r) | (x,r) <- readDec s ]
instance Eq Int64 where
(I64# x) == (I64# y) = x `eqInt64#` y
@@ -719,6 +748,7 @@ instance Num Int64 where
fromInteger i = integerToInt64 i
fromInt i = intToInt64 i
+compareInt64# :: Int64# -> Int64# -> Ordering
compareInt64# i# j#
| i# `ltInt64#` j# = LT
| i# `eqInt64#` j# = EQ
@@ -732,7 +762,7 @@ instance Real Int64 where
toRational x = toInteger x % 1
instance Integral Int64 where
- div x@(I64# x#) y@(I64# y#)
+ div x y
| x > 0 && y < 0 = quotInt64 (x-y-1) y
| x < 0 && y > 0 = quotInt64 (x-y+1) y
| otherwise = quotInt64 x y
@@ -745,7 +775,7 @@ instance Integral Int64 where
| y# `neInt64#` (intToInt64# 0#) = x `remInt64` y
| otherwise = error "Integral.Int32.rem: divide by 0\n"
- mod x@(I64# x#) y@(I64# y#)
+ mod x y
| x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
| otherwise = r
where r = remInt64 x y
@@ -755,6 +785,13 @@ instance Integral Int64 where
toInt i = int64ToInt i
instance Enum Int64 where
+ succ i
+ | i == maxBound = error ("Enum{Int64}.succ: tried to take `succ' of " ++ show i)
+ | otherwise = i+1
+ pred i
+ | i == minBound = error ("Enum{Int64}.pred: tried to take `pred' of " ++ show i)
+ | otherwise = i+1
+
toEnum (I# i) = I64# (intToInt64# i)
fromEnum (I64# w) = I# (int64ToInt# w)
enumFrom i = eft64 i 1
@@ -796,6 +833,7 @@ instance Bits Int64 where
bitSize _ = 64
isSigned _ = True
+remInt64, quotInt64 :: Int64 -> Int64 -> Int64
remInt64 (I64# x) (I64# y) = I64# (x `remInt64#` y)
quotInt64 (I64# x) (I64# y) = I64# (x `quotInt64#` y)
@@ -808,7 +846,7 @@ int64ToInt (I64# i#) = I# (int64ToInt# i#)
-- Enum Int64 helper funs:
eftt64 :: Int64 -> Int64 -> (Int64->Bool) -> [Int64]
-eftt64 now step done = go now
+eftt64 init step done = go init
where
go now
| done now = []
@@ -942,14 +980,14 @@ shiftRL64# a# b# =
W64# w# -> w#
int64ToInt# :: Int64# -> Int#
-int64ToInt# i# =
- case (unsafePerformIO (_ccall_ stg_int64ToInt i#)) of
+int64ToInt# i64# =
+ case (unsafePerformIO (_ccall_ stg_int64ToInt i64#)) of
I# i# -> i#
wordToWord64# :: Word# -> Word64#
wordToWord64# w# =
case (unsafePerformIO (_ccall_ stg_wordToWord64 w#)) of
- W64# w# -> w#
+ W64# w64# -> w64#
word64ToInt64# :: Word64# -> Int64#
word64ToInt64# w# =
@@ -957,18 +995,25 @@ word64ToInt64# w# =
I64# i# -> i#
int64ToWord64# :: Int64# -> Word64#
-int64ToWord64# w# =
- case (unsafePerformIO (_ccall_ stg_int64ToWord64 w#)) of
+int64ToWord64# i# =
+ case (unsafePerformIO (_ccall_ stg_int64ToWord64 i#)) of
W64# w# -> w#
intToInt64# :: Int# -> Int64#
intToInt64# i# =
case (unsafePerformIO (_ccall_ stg_intToInt64 i#)) of
- I64# i# -> i#
-
+ I64# i64# -> i64#
#endif
+instance Ix Int64 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = int64ToInt (i-m)
+ | otherwise = indexError i b "Int64"
+ inRange (m,n) i = m <= i && i <= n
+
+
sizeofInt64 :: Word32
sizeofInt64 = 8
\end{code}
@@ -982,9 +1027,11 @@ sizeofInt64 = 8
Code copied from the Prelude
\begin{code}
+absReal :: (Ord a, Num a) => a -> a
absReal x | x >= 0 = x
| otherwise = -x
+signumReal :: (Ord a, Num a) => a -> a
signumReal x | x == 0 = 0
| x > 0 = 1
| otherwise = -1
@@ -1143,3 +1190,17 @@ writeInt64OffForeignObj fo i e = _casm_ `` (((StgInt64*)%0)[(StgInt)%1])=(StgInt
\end{code}
+
+C&P'ed from Ix.lhs
+
+\begin{code}
+{-# NOINLINE indexError #-}
+indexError :: Show a => a -> (a,a) -> String -> b
+indexError i rng tp
+ = error (showString "Ix{" . showString tp . showString "}.index: Index " .
+ showParen True (showsPrec 0 i) .
+ showString " out of range " $
+ showParen True (showsPrec 0 rng) "")
+
+
+\end{code}
diff --git a/ghc/lib/exts/LazyST.lhs b/ghc/lib/exts/LazyST.lhs
index 49898025d129f748a6baa909a67f3874b67186df..07bf7a7a170c19bd51f68f6031449b54e5d655b3 100644
--- a/ghc/lib/exts/LazyST.lhs
+++ b/ghc/lib/exts/LazyST.lhs
@@ -40,7 +40,7 @@ import PrelGHC
newtype ST s a = ST (PrelST.State s -> (a,PrelST.State s))
instance Functor (ST s) where
- map f m = ST $ \ s ->
+ fmap f m = ST $ \ s ->
let
ST m_a = m
(r,new_s) = m_a s
@@ -51,6 +51,7 @@ instance Monad (ST s) where
return a = ST $ \ s -> (a,s)
m >> k = m >>= \ _ -> k
+ fail s = error s
(ST m) >>= k
= ST $ \ s ->
@@ -62,7 +63,7 @@ instance Monad (ST s) where
{-# NOINLINE runST #-}
runST :: (forall s. ST s a) -> a
-runST st = case st of ST st -> let (r,_) = st (PrelST.S# realWorld#) in r
+runST st = case st of ST the_st -> let (r,_) = the_st (PrelST.S# realWorld#) in r
\end{code}
%*********************************************************
@@ -106,8 +107,9 @@ readSTArray (STArray arr) ix = strictToLazyST (readArray arr ix)
writeSTArray (STArray arr) ix v = strictToLazyST (writeArray arr ix v)
boundsSTArray (STArray arr) = boundsOfArray arr
thawSTArray arr =
- strictToLazyST (thawArray arr) >>= \arr ->
- return (STArray arr)
+ strictToLazyST (thawArray arr) >>= \ marr ->
+ return (STArray marr)
+
freezeSTArray (STArray arr) = strictToLazyST (freezeArray arr)
unsafeFreezeSTArray (STArray arr) = strictToLazyST (unsafeFreezeArray arr)
@@ -115,8 +117,8 @@ strictToLazyST :: PrelST.ST s a -> ST s a
strictToLazyST m = ST $ \s ->
let
pr = case s of { PrelST.S# s# -> PrelST.liftST m s# }
- r = case pr of { PrelST.STret s2# r -> r }
- s' = case pr of { PrelST.STret s2# r -> PrelST.S# s2# }
+ r = case pr of { PrelST.STret _ v -> v }
+ s' = case pr of { PrelST.STret s2# _ -> PrelST.S# s2# }
in
(r, s')
diff --git a/ghc/lib/exts/MutableArray.lhs b/ghc/lib/exts/MutableArray.lhs
index 67afd422acf155f5d048e69e80a5fea82f2f37db..6153c44b1950e12a5ae4a50887e713734daa43fd 100644
--- a/ghc/lib/exts/MutableArray.lhs
+++ b/ghc/lib/exts/MutableArray.lhs
@@ -140,9 +140,9 @@ freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
-> State# s -- the Universe and everything
-> (# State# s, ByteArray# #)
- freeze arr# n# s#
- = case (newStablePtrArray# n# s#) of { (# s2# , newarr1# #) ->
- case copy 0# n# arr# newarr1# s2# of { (# s3# , newarr2# #) ->
+ freeze arr1# n# s#
+ = case (newStablePtrArray# n# s#) of { (# s2# , newarr1# #) ->
+ case copy 0# n# arr1# newarr1# s2# of { (# s3# , newarr2# #) ->
unsafeFreezeByteArray# newarr2# s3#
}}
where
@@ -151,11 +151,11 @@ freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
-> State# s
-> (# State# s , MutableByteArray# s #)
- copy cur# end# from# to# s#
+ copy cur# end# from# to# st#
| cur# ==# end#
- = (# s# , to# #)
+ = (# st# , to# #)
| otherwise
- = case (readStablePtrArray# from# cur# s#) of { (# s1# , ele #) ->
+ = case (readStablePtrArray# from# cur# st#) of { (# s1# , ele #) ->
case (writeStablePtrArray# to# cur# ele s1#) of { s2# ->
copy (cur# +# 1#) end# from# to# s2#
}}
diff --git a/ghc/lib/exts/Word.lhs b/ghc/lib/exts/Word.lhs
index 82eb72957520d26b9817bdbf3e0df05a6b003f7f..6e255f1b2abb1ae299444ceea256b2648a78e3f0 100644
--- a/ghc/lib/exts/Word.lhs
+++ b/ghc/lib/exts/Word.lhs
@@ -102,6 +102,7 @@ import PrelAddr
#endif
import Ix
import Bits
+import Ratio
import Numeric (readDec, showInt)
-----------------------------------------------------------------------------
@@ -123,8 +124,11 @@ intToWord8 = word32ToWord8 . intToWord32
word16ToInt = word32ToInt . word16ToWord32
intToWord16 = word32ToWord16 . intToWord32
+intToWord32 :: Int -> Word32
intToWord32 (I# x) = W32# ((int2Word# x) `and#` (case (maxBound::Word32) of W32# x# -> x#))
--intToWord32 (I# x) = W32# (int2Word# x)
+
+word32ToInt :: Word32 -> Int
word32ToInt (W32# x) = I# (word2Int# x)
wordToInt :: Word -> Int
@@ -218,15 +222,19 @@ instance Integral Word8 where
instance Ix Word8 where
range (m,n) = [m..n]
- index b@(m,n) i
+ index b@(m,_) i
| 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) "")
+ | otherwise = indexError i b "Word8"
inRange (m,n) i = m <= i && i <= n
instance Enum Word8 where
+ succ w
+ | w == maxBound = error ("Enum{Word8}.succ: tried to take `succ' of " ++ show w)
+ | otherwise = w+1
+ pred w
+ | w == minBound = error ("Enum{Word8}.pred: tried to take `pred' of " ++ show w)
+ | otherwise = w+1
+
toEnum (I# i) = W8# (intToWord8# i)
fromEnum (W8# w) = I# (word2Int# w)
enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Word8)]
@@ -234,10 +242,10 @@ instance Enum Word8 where
where last = if d < c then minBound else maxBound
instance Read Word8 where
- readsPrec p = readDec
+ readsPrec _ = readDec
instance Show Word8 where
- showsPrec p = showInt
+ showsPrec _ = showInt
--
-- Word8s are represented by an (unboxed) 32-bit Word.
@@ -280,6 +288,7 @@ instance Bits Word8 where
pow2# :: Int# -> Int#
pow2# x# = word2Int# (shiftL# (int2Word# 1#) x#)
+word2Integer :: Word# -> Integer
word2Integer w = case word2Integer# w of
(# a, s, d #) -> J# a s d
@@ -368,15 +377,18 @@ instance Integral Word16 where
instance Ix Word16 where
range (m,n) = [m..n]
- index b@(m,n) i
+ index b@(m,_) i
| 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) "")
+ | otherwise = indexError i b "Word16"
inRange (m,n) i = m <= i && i <= n
instance Enum Word16 where
+ succ w
+ | w == maxBound = error ("Enum{Word16}.succ: tried to take `succ' of " ++ show w)
+ | otherwise = w+1
+ pred w
+ | w == minBound = error ("Enum{Word16}.pred: tried to take `pred' of " ++ show w)
+ | otherwise = w+1
toEnum (I# i) = W16# (intToWord16# i)
fromEnum (W16# w) = I# (word2Int# w)
enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Word16)]
@@ -384,10 +396,10 @@ instance Enum Word16 where
where last = if d < c then minBound else maxBound
instance Read Word16 where
- readsPrec p = readDec
+ readsPrec _ = readDec
instance Show Word16 where
- showsPrec p = showInt
+ showsPrec _ = showInt
instance Bits Word16 where
(W16# x) .&. (W16# y) = W16# (x `and#` y)
@@ -517,20 +529,24 @@ instance Integral Word32 where
{-# INLINE quotWord32 #-}
{-# INLINE remWord32 #-}
+remWord32, quotWord32 :: Word32 -> Word32 -> Word32
(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
+ index b@(m,_) i
| inRange b i = word32ToInt (i - m)
- | otherwise = error (showString "Ix{Word32}.index: Index " .
- showParen True (showsPrec 0 i) .
- showString " out of range " $
- showParen True (showsPrec 0 b) "")
+ | otherwise = indexError i b "Word32"
inRange (m,n) i = m <= i && i <= n
instance Enum Word32 where
+ succ w
+ | w == maxBound = error ("Enum{Word32}.succ: tried to take `succ' of " ++ show w)
+ | otherwise = w+1
+ pred w
+ | w == minBound = error ("Enum{Word32}.pred: tried to take `pred' of " ++ show w)
+ | otherwise = w+1
toEnum = intToWord32
fromEnum = word32ToInt -- lossy, don't use.
enumFrom w = [w .. maxBound]
@@ -562,7 +578,7 @@ instance Enum Word32 where
| otherwise = x - diff2
eftt32 :: Word32 -> (Word32 -> Maybe Word32) -> [Word32]
-eftt32 now stepper = go now
+eftt32 init stepper = go init
where
go now =
case stepper now of
@@ -577,10 +593,10 @@ eft32 now last = go now
| otherwise = x:go (x+1)
instance Read Word32 where
- readsPrec p = readDec
+ readsPrec _ = readDec
instance Show Word32 where
- showsPrec p = showInt
+ showsPrec _ = showInt
instance Bits Word32 where
(W32# x) .&. (W32# y) = W32# (x `and#` y)
@@ -692,15 +708,18 @@ instance Integral Word64 where
instance Ix Word64 where
range (m,n) = [m..n]
- index b@(m,n) i
+ index b@(m,_) i
| inRange b i = word64ToInt (i-m)
- | otherwise = error (showString "Ix{Word64}.index: Index " .
- showParen True (showsPrec 0 i) .
- showString " out of range " $
- showParen True (showsPrec 0 b) "")
+ | otherwise = indexError i b "Word64"
inRange (m,n) i = m <= i && i <= n
instance Enum Word64 where
+ succ w
+ | w == maxBound = error ("Enum{Word64}.succ: tried to take `succ' of " ++ show w)
+ | otherwise = w+1
+ pred w
+ | w == minBound = error ("Enum{Word64}.pred: tried to take `pred' of " ++ show w)
+ | otherwise = w+1
toEnum (I# i) = W64# (intToWord# i)
fromEnum (W64# w) = I# (word2Int# w) -- lossy, don't use.
enumFrom w = eft64 w 1
@@ -712,10 +731,10 @@ instance Enum Word64 where
| otherwise = minBound
instance Read Word64 where
- readsPrec p = readDec
+ readsPrec _ = readDec
instance Show Word64 where
- showsPrec p = showInt
+ showsPrec _ = showInt
instance Bits Word64 where
@@ -772,7 +791,7 @@ word64ToInteger (W64# w#) =
word64ToInt :: Word64 -> Int
word64ToInt w =
case w `quotRem` 0x100000000 of
- (h,l) -> toInt (word64ToWord32 l)
+ (_,l) -> toInt (word64ToWord32 l)
intToWord64# :: Int# -> Word64#
intToWord64# i# = wordToWord64# (int2Word# i#)
@@ -787,7 +806,7 @@ instance Show Word64 where
showsPrec p x = showsPrec p (word64ToInteger x)
instance Read Word64 where
- readsPrec p s = [ (integerToWord64 x,r) | (x,r) <- readDec s ]
+ readsPrec _ s = [ (integerToWord64 x,r) | (x,r) <- readDec s ]
instance Eq Word64 where
(W64# x) == (W64# y) = x `eqWord64#` y
@@ -842,15 +861,18 @@ instance Integral Word64 where
instance Ix Word64 where
range (m,n) = [m..n]
- index b@(m,n) i
+ index b@(m,_) i
| inRange b i = word64ToInt (i-m)
- | otherwise = error (showString "Ix{Word64}.index: Index " .
- showParen True (showsPrec 0 i) .
- showString " out of range " $
- showParen True (showsPrec 0 b) "")
+ | otherwise = indexError i b "Word64"
inRange (m,n) i = m <= i && i <= n
instance Enum Word64 where
+ succ w
+ | w == maxBound = error ("Enum{Word64}.succ: tried to take `succ' of " ++ show w)
+ | otherwise = w+1
+ pred w
+ | w == minBound = error ("Enum{Word64}.pred: tried to take `pred' of " ++ show w)
+ | otherwise = w+1
toEnum (I# i) = W64# (intToWord64# i)
fromEnum (W64# w) = I# (word2Int# (word64ToWord# w)) -- lossy, don't use.
enumFrom w = eft64 w 1
@@ -898,6 +920,7 @@ instance Bits Word64 where
bitSize _ = 64
isSigned _ = False
+compareWord64# :: Word64# -> Word64# -> Ordering
compareWord64# i# j#
| i# `ltWord64#` j# = LT
| i# `eqWord64#` j# = EQ
@@ -1008,29 +1031,29 @@ shiftRL64# a# b# =
W64# w# -> w#
word64ToWord# :: Word64# -> Word#
-word64ToWord# w# =
- case (unsafePerformIO (_ccall_ stg_word64ToWord w#)) of
+word64ToWord# w64# =
+ case (unsafePerformIO (_ccall_ stg_word64ToWord w64#)) of
W# w# -> w#
wordToWord64# :: Word# -> Word64#
wordToWord64# w# =
case (unsafePerformIO (_ccall_ stg_wordToWord64 w#)) of
- W64# w# -> w#
+ W64# w64# -> w64#
word64ToInt64# :: Word64# -> Int64#
-word64ToInt64# w# =
- case (unsafePerformIO (_ccall_ stg_word64ToInt64 w#)) of
+word64ToInt64# w64# =
+ case (unsafePerformIO (_ccall_ stg_word64ToInt64 w64#)) of
I64# i# -> i#
int64ToWord64# :: Int64# -> Word64#
-int64ToWord64# w# =
- case (unsafePerformIO (_ccall_ stg_int64ToWord64 w#)) of
+int64ToWord64# i64# =
+ case (unsafePerformIO (_ccall_ stg_int64ToWord64 i64#)) of
W64# w# -> w#
intToInt64# :: Int# -> Int64#
intToInt64# i# =
case (unsafePerformIO (_ccall_ stg_intToInt64 i#)) of
- I64# i# -> i#
+ I64# i64# -> i64#
#endif
@@ -1040,7 +1063,7 @@ sizeofWord64 = 8
-- Enum Word64 helper funs:
eftt64 :: Word64 -> Word64 -> (Word64->Bool) -> [Word64]
-eftt64 now step done = go now
+eftt64 init step done = go init
where
go now
| done now = []
@@ -1091,6 +1114,7 @@ The remainder of this file consists of definitions which are only
used in the implementation.
\begin{code}
+signumReal :: (Ord a, Num a) => a -> a
signumReal x | x == 0 = 0
| x > 0 = 1
| otherwise = -1
@@ -1225,7 +1249,7 @@ writeWord16OffAddr :: Addr -> Int -> Word16 -> IO ()
writeWord16OffAddr a i e = _casm_ `` (((StgNat16*)%0)[(StgInt)%1])=(StgNat16)%2; '' a i e
writeWord32OffAddr :: Addr -> Int -> Word32 -> IO ()
-writeWord32OffAddr (A# a#) i@(I# i#) (W32# w#) = IO $ \ s# ->
+writeWord32OffAddr (A# a#) i (W32# w#) = IO $ \ s# ->
case (writeWordOffAddr# a# i'# w# s#) of s2# -> (# s2#, () #)
where
-- adjust index to be in Word units, not Word32 ones.
@@ -1274,3 +1298,17 @@ writeWord64OffForeignObj fo i e = _casm_ `` (((StgNat64*)%0)[(StgInt)%1])=(StgNa
#endif
\end{code}
+
+C&P'ed from Ix.lhs
+
+\begin{code}
+{-# NOINLINE indexError #-}
+indexError :: Show a => a -> (a,a) -> String -> b
+indexError i rng tp
+ = error (showString "Ix{" . showString tp . showString "}.index: Index " .
+ showParen True (showsPrec 0 i) .
+ showString " out of range " $
+ showParen True (showsPrec 0 rng) "")
+
+
+\end{code}