* Misc changes to reflect that we're now speaking Haskell 98.
* Augmented IOExts export list with
unsafeIOToST :: IO a -> ST s a
stToIO :: ST s a -> IO a
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
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
(
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
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
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
\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"
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"
\end{code}
-\begin{code}
+begin{code}
+test1,test2, test3, test4 :: Dynamic
+
test1 = toDyn (1::Int)
test2 = toDyn ((+) :: Int -> Int -> Int)
test3 = dynApp test2 test1
test6 = fromDyn test1 0
test7 = fromDyn test2 0
+test8 :: Dynamic
test8 = toDyn (mkAppTy listTc)
+
test9 :: Float
test9 = fromDyn test8 0
test10 :: IO ()
test10 = printf "%n = %c, that much is %b\n" [toDyn (3::Int),toDyn 'a', toDyn False]
-\end{code}
+end{code}
% -----------------------------------------------------------------------------
-% $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
%
#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)
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)
case fromDynamic dyn of
Just exception -> k exception
Nothing -> throw ex
- other -> throw ex
+ _ -> throw ex
\end{code}
-----------------------------------------------------------------------------
, 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#,
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
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]
-- 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)
-- misc bits
trace,
- Lift(..),
-- and finally, all the unboxed primops of PrelGHC!
module PrelGHC
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 = (>>=)
, unsafePtrEq
, unsafeIOToST
+ , stToIO
) where
#endif
import Ix
import Bits
+import Ratio ( (%) )
import Numeric ( readDec )
import Word ( Word32 )
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#)
-- 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
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)]
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
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)]
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)]
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
| 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
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!
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
fromInteger i = integerToInt64 i
fromInt i = intToInt64 i
+compareInt64# :: Int64# -> Int64# -> Ordering
compareInt64# i# j#
| i# `ltInt64#` j# = LT
| i# `eqInt64#` j# = EQ
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
| 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
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
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)
-- 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 = []
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# =
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}
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
\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}
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
return a = ST $ \ s -> (a,s)
m >> k = m >>= \ _ -> k
+ fail s = error s
(ST m) >>= k
= ST $ \ s ->
{-# 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}
%*********************************************************
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)
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')
-> 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
-> 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#
}}
#endif
import Ix
import Bits
+import Ratio
import Numeric (readDec, showInt)
-----------------------------------------------------------------------------
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
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)]
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.
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
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)]
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)
{-# 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]
| 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
| 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)
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
| otherwise = minBound
instance Read Word64 where
- readsPrec p = readDec
+ readsPrec _ = readDec
instance Show Word64 where
- showsPrec p = showInt
+ showsPrec _ = showInt
instance Bits Word64 where
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#)
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
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
bitSize _ = 64
isSigned _ = False
+compareWord64# :: Word64# -> Word64# -> Ordering
compareWord64# i# j#
| i# `ltWord64#` j# = LT
| i# `eqWord64#` j# = EQ
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
-- 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 = []
used in the implementation.
\begin{code}
+signumReal :: (Ord a, Num a) => a -> a
signumReal x | x == 0 = 0
| x > 0 = 1
| otherwise = -1
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.
#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}
projects / ghc-hetmet.git / commitdiff