Commit 34df3534 authored by simonmar's avatar simonmar

[project @ 1999-10-05 09:02:30 by simonmar]

Flatten out the tuple of bounds in the Array, MutableArray and
ByteArray datatypes.  This improves performance of heavy array
manipulations quite significantly.
parent b6a02c44
......@@ -136,13 +136,13 @@ unboxArg arg
-- Byte-arrays, both mutable and otherwise; hack warning
| is_product_type &&
length data_con_arg_tys == 2 &&
maybeToBool maybe_arg2_tycon &&
(arg2_tycon == byteArrayPrimTyCon ||
arg2_tycon == mutableByteArrayPrimTyCon)
length data_con_arg_tys == 3 &&
maybeToBool maybe_arg3_tycon &&
(arg3_tycon == byteArrayPrimTyCon ||
arg3_tycon == mutableByteArrayPrimTyCon)
-- and, of course, it is an instance of CCallable
= newSysLocalDs arg_ty `thenDs` \ case_bndr ->
newSysLocalsDs data_con_arg_tys `thenDs` \ vars@[ixs_var, arr_cts_var] ->
newSysLocalsDs data_con_arg_tys `thenDs` \ vars@[l_var, r_var, arr_cts_var] ->
returnDs (Var arr_cts_var,
\ body -> Case arg case_bndr [(DataCon data_con,vars,body)]
)
......@@ -167,10 +167,11 @@ unboxArg arg
maybe_product_type = splitProductType_maybe arg_ty
is_product_type = maybeToBool maybe_product_type
Just (tycon, _, data_con, data_con_arg_tys) = maybe_product_type
(data_con_arg_ty1 : data_con_arg_ty2 : _) = data_con_arg_tys
(data_con_arg_ty1 : data_con_arg_ty2 : data_con_arg_ty3 :_)
= data_con_arg_tys
maybe_arg2_tycon = splitTyConApp_maybe data_con_arg_ty2
Just (arg2_tycon,_) = maybe_arg2_tycon
maybe_arg3_tycon = splitTyConApp_maybe data_con_arg_ty3
Just (arg3_tycon,_) = maybe_arg3_tycon
can'tSeeDataConsPanic thing ty
= pprPanic
......
......@@ -565,13 +565,13 @@ ccallable_type ty = isUnLiftedType ty || -- Allow CCallable Int# etc
byte_arr_thing
where
byte_arr_thing = case splitProductType_maybe ty of
Just (tycon, ty_args, data_con, [data_con_arg_ty1, data_con_arg_ty2]) ->
maybeToBool maybe_arg2_tycon &&
(arg2_tycon == byteArrayPrimTyCon ||
arg2_tycon == mutableByteArrayPrimTyCon)
Just (tycon, ty_args, data_con, [data_con_arg_ty1, data_con_arg_ty2, data_con_arg_ty3]) ->
maybeToBool maybe_arg3_tycon &&
(arg3_tycon == byteArrayPrimTyCon ||
arg3_tycon == mutableByteArrayPrimTyCon)
where
maybe_arg2_tycon = splitTyConApp_maybe data_con_arg_ty2
Just (arg2_tycon,_) = maybe_arg2_tycon
maybe_arg3_tycon = splitTyConApp_maybe data_con_arg_ty3
Just (arg3_tycon,_) = maybe_arg3_tycon
other -> False
......
......@@ -37,8 +37,8 @@ import Ix
\begin{code}
indexStablePtrArray :: Ix ix => ByteArray ix -> ix -> (StablePtr a)
indexStablePtrArray (ByteArray ixs barr#) n
= case (index ixs n) of { I# n# ->
indexStablePtrArray (ByteArray l u barr#) n
= case (index (l,u) n) of { I# n# ->
case indexStablePtrArray# barr# n# of { r# ->
(StablePtr r#)}}
\end{code}
......@@ -47,12 +47,12 @@ The size returned is in bytes.
\begin{code}
sizeofByteArray :: Ix ix => ByteArray ix -> Int
sizeofByteArray (ByteArray _ arr#) =
sizeofByteArray (ByteArray _ _ arr#) =
case (sizeofByteArray# arr#) of
i# -> (I# i#)
boundsOfByteArray :: Ix ix => ByteArray ix -> (ix, ix)
boundsOfByteArray (ByteArray ixs _) = ixs
boundsOfByteArray (ByteArray l u _) = (l,u)
\end{code}
\begin{code}
......
......@@ -107,7 +107,7 @@ not supported.
\begin{code}
sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
sizeofMutableByteArray (MutableByteArray _ arr#) =
sizeofMutableByteArray (MutableByteArray _ _ arr#) =
case (sizeofMutableByteArray# arr#) of
i# -> (I# i#)
......@@ -115,28 +115,28 @@ sizeofMutableByteArray (MutableByteArray _ arr#) =
\begin{code}
newStablePtrArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
newStablePtrArray ixs = ST $ \ s# ->
newStablePtrArray ixs@(l,u) = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
case (newStablePtrArray# n# s#) of { (# s2#, barr# #) ->
(# s2#, (MutableByteArray ixs barr#) #) }}
(# s2#, (MutableByteArray l u barr#) #) }}
readStablePtrArray :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
readStablePtrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
readStablePtrArray (MutableByteArray l u barr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readStablePtrArray# barr# n# s# of { (# s2#, r# #) ->
(# s2# , (StablePtr r#) #) }}
writeStablePtrArray :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a -> ST s ()
writeStablePtrArray (MutableByteArray ixs barr#) n (StablePtr sp#) = ST $ \ s# ->
case (index ixs n) of { I# n# ->
writeStablePtrArray (MutableByteArray l u barr#) n (StablePtr sp#) = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case writeStablePtrArray# barr# n# sp# s# of { s2# ->
(# s2# , () #) }}
freezeStablePtrArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
freezeStablePtrArray (MutableByteArray l u arr#) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case freeze arr# n# s# of { (# s2# , frozen# #) ->
(# s2# , ByteArray ixs frozen# #) }}
(# s2# , ByteArray l u frozen# #) }}
where
freeze :: MutableByteArray# s -- the thing
-> Int# -- size of thing to be frozen
......@@ -174,14 +174,14 @@ readWord8Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Word8
readWord16Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Word16
readWord32Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Word32
readWord8Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
readWord8Array (MutableByteArray l u arr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readCharArray# arr# n# s# of { (# s2# , r# #) ->
(# s2# , intToWord8 (I# (ord# r#)) #) }}
readWord16Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
readWord16Array (MutableByteArray l u arr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readWordArray# arr# (n# `quotInt#` 2#) s# of { (# s2# , w# #) ->
case n# `remInt#` 2# of
0# -> (# s2# , wordToWord16 (W# w#) #)
......@@ -190,8 +190,8 @@ readWord16Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
-- take the upper 16 bits.
}}
readWord32Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
readWord32Array (MutableByteArray l u arr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readWordArray# arr# n# s# of { (# s2# , w# #) ->
(# s2# , wordToWord32 (W# w#) #) }}
......@@ -211,13 +211,13 @@ writeWord8Array :: (Ix ix) => MutableByteArray s ix -> ix -> Word8 -> ST s ()
writeWord16Array :: (Ix ix) => MutableByteArray s ix -> ix -> Word16 -> ST s ()
writeWord32Array :: (Ix ix) => MutableByteArray s ix -> ix -> Word32 -> ST s ()
writeWord8Array (MutableByteArray ixs arr#) n w = ST $ \ s# ->
case (index ixs n) of
writeWord8Array (MutableByteArray l u arr#) n w = ST $ \ s# ->
case (index (l,u) n) of
I# n# -> case writeCharArray# arr# n# (chr# (word2Int# (word8ToWord# w))) s# of
s2# -> (# s2# , () #)
writeWord16Array (MutableByteArray ixs arr#) n w = ST $ \ s# ->
case (index ixs n) of
writeWord16Array (MutableByteArray l u arr#) n w = ST $ \ s# ->
case (index (l,u) n) of
I# n# ->
let
w# =
......@@ -236,8 +236,8 @@ writeWord16Array (MutableByteArray ixs arr#) n w = ST $ \ s# ->
case writeWordArray# arr# (n# `quotInt#` 2#) (w# `or#` (v# `and#` mask )) s2# of
s3# -> (# s3# , () #)
writeWord32Array (MutableByteArray ixs arr#) n w = ST $ \ s# ->
case (index ixs n) of
writeWord32Array (MutableByteArray l u arr#) n w = ST $ \ s# ->
case (index (l,u) n) of
I# n# ->
case writeWordArray# arr# n# w# s# of
s2# -> (# s2# , () #)
......@@ -267,13 +267,13 @@ readInt8Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Int8
readInt16Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Int16
readInt32Array :: (Ix ix) => MutableByteArray s ix -> ix -> ST s Int32
readInt8Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
readInt8Array (MutableByteArray l u arr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readCharArray# arr# n# s# of { (# s2# , r# #) ->
(# s2# , intToInt8 (I# (ord# r#)) #) }}
readInt16Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
case (index ixs n) of
readInt16Array (MutableByteArray l u arr#) n = ST $ \ s# ->
case (index (l,u) n) of
I# n# ->
case readIntArray# arr# (n# `quotInt#` 2#) s# of
(# s2# , i# #) ->
......@@ -281,8 +281,8 @@ readInt16Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
0# -> (# s2# , intToInt16 (I# i#) #)
1# -> (# s2# , intToInt16 (I# (word2Int# (shiftRL# (int2Word# i#) 16# ))) #)
readInt32Array (MutableByteArray ixs arr#) n = ST $ \ s# ->
case (index ixs n) of
readInt32Array (MutableByteArray l u arr#) n = ST $ \ s# ->
case (index (l,u) n) of
I# n# -> case readIntArray# arr# n# s# of
(# s2# , i# #) -> (# s2# , intToInt32 (I# i#) #)
......@@ -300,16 +300,16 @@ writeInt8Array :: (Ix ix) => MutableByteArray s ix -> ix -> Int8 -> ST s ()
writeInt16Array :: (Ix ix) => MutableByteArray s ix -> ix -> Int16 -> ST s ()
writeInt32Array :: (Ix ix) => MutableByteArray s ix -> ix -> Int32 -> ST s ()
writeInt8Array (MutableByteArray ixs arr#) n i = ST $ \ s# ->
case (index ixs n) of
writeInt8Array (MutableByteArray l u arr#) n i = ST $ \ s# ->
case (index (l,u) n) of
I# n# ->
case writeCharArray# arr# n# ch s# of
s2# -> (# s2# , () #)
where
ch = chr# (int8ToInt# i)
writeInt16Array (MutableByteArray ixs arr#) n i = ST $ \ s# ->
case (index ixs n) of
writeInt16Array (MutableByteArray l u arr#) n i = ST $ \ s# ->
case (index (l,u) n) of
I# n# ->
let
i# =
......@@ -330,8 +330,8 @@ writeInt16Array (MutableByteArray ixs arr#) n i = ST $ \ s# ->
case writeIntArray# arr# (n# `quotInt#` 2#) w' s2# of
s2# -> (# s2# , () #)
writeInt32Array (MutableByteArray ixs arr#) n i = ST $ \ s# ->
case (index ixs n) of
writeInt32Array (MutableByteArray l u arr#) n i = ST $ \ s# ->
case (index (l,u) n) of
I# n# ->
case writeIntArray# arr# n# i# s# of
s2# -> (# s2# , () #)
......@@ -357,13 +357,13 @@ writeInt64Array mb n w = do
\begin{code}
{-# SPECIALIZE boundsOfMutableByteArray :: MutableByteArray s Int -> IPr #-}
boundsOfMutableByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
boundsOfMutableByteArray (MutableByteArray ixs _) = ixs
boundsOfMutableByteArray (MutableByteArray l u _) = (l,u)
\end{code}
\begin{code}
thawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
thawByteArray (ByteArray ixs barr#) =
thawByteArray (ByteArray l u barr#) =
{-
The implementation is made more complex by the
fact that the indexes are in units of whatever
......@@ -375,8 +375,8 @@ thawByteArray (ByteArray ixs barr#) =
mapM_ (\ idx@(I# idx#) ->
writeCharArray marr idx (C# (indexCharArray# barr# idx#)))
[0..]
let (MutableByteArray _ arr#) = marr
return (MutableByteArray ixs arr#)
let (MutableByteArray _ _ arr#) = marr
return (MutableByteArray l u arr#)
{-
in-place conversion of immutable arrays to mutable ones places
......@@ -385,8 +385,8 @@ thawByteArray (ByteArray ixs barr#) =
thaw it (and, subsequently mutate it, I suspect.)
-}
unsafeThawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
unsafeThawByteArray (ByteArray ixs barr#) = ST $ \ s# ->
unsafeThawByteArray (ByteArray l u barr#) = ST $ \ s# ->
case unsafeThawByteArray# barr# s# of
(# s2#, arr# #) -> (# s2#, MutableByteArray ixs arr# #)
(# s2#, arr# #) -> (# s2#, MutableByteArray l u arr# #)
\end{code}
......@@ -104,7 +104,7 @@ unpackNBytesBAIO ba l = unpackNBytesAccBAIO ba l []
-- note: no bounds checking!
unpackNBytesAccBAIO :: ByteArray Int -> Int -> [Char] -> IO [Char]
unpackNBytesAccBAIO _ 0 rest = return rest
unpackNBytesAccBAIO (ByteArray _ ba) (I# len#) rest = unpack rest (len# -# 1#)
unpackNBytesAccBAIO (ByteArray _ _ ba) (I# len#) rest = unpack rest (len# -# 1#)
where
unpack acc i#
| i# <# 0# = return acc
......
......@@ -26,7 +26,7 @@ digest :: String -> IO String
digest str = do
ps <- stToIO (packStringST str)
ba <- digestPS ps
let (ByteArray _ ba#) = ba
let (ByteArray _ _ ba#) = ba
baToString ba# 16# 0#
where
baToString ba# n# i#
......
......@@ -149,8 +149,8 @@ comparePS (PS bs1 len1 has_null1) (PS bs2 len2 has_null2)
else GT
))
where
ba1 = ByteArray (0, I# (len1 -# 1#)) bs1
ba2 = ByteArray (0, I# (len2 -# 1#)) bs2
ba1 = ByteArray 0 (I# (len1 -# 1#)) bs1
ba2 = ByteArray 0 (I# (len2 -# 1#)) bs2
comparePS (PS bs1 len1 has_null1) (CPS bs2 _)
| not has_null1
......@@ -162,7 +162,7 @@ comparePS (PS bs1 len1 has_null1) (CPS bs2 _)
else GT
))
where
ba1 = ByteArray (0, I# (len1 -# 1#)) bs1
ba1 = ByteArray 0 (I# (len1 -# 1#)) bs1
ba2 = A# bs2
comparePS (CPS bs1 len1) (CPS bs2 _)
......@@ -242,7 +242,7 @@ packNCharsST (I# length#) str =
-- fill in packed string from "str"
fill_in ch_array 0# str >>
-- freeze the puppy:
freeze_ps_array ch_array length# >>= \ (ByteArray _ frozen#) ->
freeze_ps_array ch_array length# >>= \ (ByteArray _ _ frozen#) ->
let has_null = byteArrayHasNUL# frozen# length# in
return (PS frozen# length# has_null)
where
......@@ -256,13 +256,14 @@ packNCharsST (I# length#) str =
fill_in arr_in# (idx +# 1#) cs
byteArrayToPS :: ByteArray Int -> PackedString
byteArrayToPS (ByteArray ixs@(_, ix_end) frozen#) =
byteArrayToPS (ByteArray l u frozen#) =
let
ixs = (l,u)
n# =
case (
if null (range ixs)
then 0
else ((index ixs ix_end) + 1)
else ((index ixs u) + 1)
) of { I# x -> x }
in
PS frozen# n# (byteArrayHasNUL# frozen# n#)
......@@ -270,13 +271,14 @@ byteArrayToPS (ByteArray ixs@(_, ix_end) frozen#) =
-- byteArray is zero-terminated, make everything upto it
-- a packed string.
cByteArrayToPS :: ByteArray Int -> PackedString
cByteArrayToPS (ByteArray ixs@(_, ix_end) frozen#) =
cByteArrayToPS (ByteArray l u frozen#) =
let
ixs = (l,u)
n# =
case (
if null (range ixs)
then 0
else ((index ixs ix_end) + 1)
else ((index ixs u) + 1)
) of { I# x -> x }
len# = findNull 0#
......@@ -290,11 +292,11 @@ cByteArrayToPS (ByteArray ixs@(_, ix_end) frozen#) =
PS frozen# len# False
unsafeByteArrayToPS :: ByteArray a -> Int -> PackedString
unsafeByteArrayToPS (ByteArray _ frozen#) (I# n#)
unsafeByteArrayToPS (ByteArray _ _ frozen#) (I# n#)
= PS frozen# n# (byteArrayHasNUL# frozen# n#)
psToByteArray :: PackedString -> ByteArray Int
psToByteArray (PS bytes n _) = ByteArray (0, I# (n -# 1#)) bytes
psToByteArray (PS bytes n _) = ByteArray 0 (I# (n -# 1#)) bytes
psToByteArray (CPS addr len#)
= let
......@@ -302,7 +304,7 @@ psToByteArray (CPS addr len#)
byte_array_form = packCBytes len (A# addr)
in
case byte_array_form of { PS bytes _ _ ->
ByteArray (0, len - 1) bytes }
ByteArray 0 (len - 1) bytes }
-- isCString is useful when passing PackedStrings to the
-- outside world, and need to figure out whether you can
......@@ -389,7 +391,7 @@ Output a packed string via a handle:
\begin{code}
hPutPS :: Handle -> PackedString -> IO ()
hPutPS handle (CPS a# len#) = hPutBuf handle (A# a#) (I# len#)
hPutPS handle (PS ba# len# _) = hPutBufBA handle (ByteArray bottom ba#) (I# len#)
hPutPS handle (PS ba# len# _) = hPutBufBA handle (ByteArray bottom bottom ba#) (I# len#)
where
bottom = error "hPutPS"
\end{code}
......@@ -404,9 +406,9 @@ hGetPS hdl len@(I# len#)
| otherwise =
-- Allocate an array for system call to store its bytes into.
stToIO (new_ps_array len# ) >>= \ ch_arr ->
stToIO (freeze_ps_array ch_arr len#) >>= \ (ByteArray _ frozen#) ->
stToIO (freeze_ps_array ch_arr len#) >>= \ (ByteArray _ _ frozen#) ->
let
byte_array = ByteArray (0, I# len#) frozen#
byte_array = ByteArray 0 (I# len#) frozen#
in
hFillBufBA hdl byte_array len >>= \ (I# read#) ->
if read# ==# 0# then -- EOF or other error
......@@ -462,7 +464,7 @@ byteArrayHasNUL# bs len
if res ==# 0# then False else True
))
where
ba = ByteArray (0, I# (len -# 1#)) bs
ba = ByteArray 0 (I# (len -# 1#)) bs
-----------------------
......@@ -515,7 +517,7 @@ mapPS f xs =
runST (
new_ps_array (length +# 1#) >>= \ ps_arr ->
whizz ps_arr length 0# >>
freeze_ps_array ps_arr length >>= \ (ByteArray _ frozen#) ->
freeze_ps_array ps_arr length >>= \ (ByteArray _ _ frozen#) ->
let has_null = byteArrayHasNUL# frozen# length in
return (PS frozen# length has_null))
where
......@@ -570,7 +572,7 @@ filterPS pred ps =
else
new_ps_array (len_filtered# +# 1#) >>= \ ps_arr ->
copy_arr ps_arr rle 0# 0# >>
freeze_ps_array ps_arr len_filtered# >>= \ (ByteArray _ frozen#) ->
freeze_ps_array ps_arr len_filtered# >>= \ (ByteArray _ _ frozen#) ->
let has_null = byteArrayHasNUL# frozen# len_filtered# in
return (PS frozen# len_filtered# has_null))
where
......@@ -745,7 +747,7 @@ reversePS ps =
runST (
new_ps_array (length +# 1#) >>= \ arr# -> -- incl NUL byte!
fill_in arr# (length -# 1#) 0# >>
freeze_ps_array arr# length >>= \ (ByteArray _ frozen#) ->
freeze_ps_array arr# length >>= \ (ByteArray _ _ frozen#) ->
let has_null = byteArrayHasNUL# frozen# length in
return (PS frozen# length has_null))
where
......@@ -772,7 +774,7 @@ concatPS pss
runST (
new_ps_array (tot_len# +# 1#) >>= \ arr# -> -- incl NUL byte!
packum arr# pss 0# >>
freeze_ps_array arr# tot_len# >>= \ (ByteArray _ frozen#) ->
freeze_ps_array arr# tot_len# >>= \ (ByteArray _ _ frozen#) ->
let has_null = byteArrayHasNUL# frozen# tot_len# in
......@@ -875,7 +877,7 @@ substrPS# ps s e
= runST (
new_ps_array (result_len# +# 1#) >>= \ ch_arr -> -- incl NUL byte!
fill_in ch_arr 0# >>
freeze_ps_array ch_arr result_len# >>= \ (ByteArray _ frozen#) ->
freeze_ps_array ch_arr result_len# >>= \ (ByteArray _ _ frozen#) ->
let has_null = byteArrayHasNUL# frozen# result_len# in
......@@ -927,7 +929,7 @@ packCBytesST (I# length#) (A# addr) =
-- fill in packed string from "addr"
fill_in ch_array 0# >>
-- freeze the puppy:
freeze_ps_array ch_array length# >>= \ (ByteArray _ frozen#) ->
freeze_ps_array ch_array length# >>= \ (ByteArray _ _ frozen#) ->
let has_null = byteArrayHasNUL# frozen# length# in
return (PS frozen# length# has_null)
where
......
......@@ -173,7 +173,7 @@ dfmt c{-e,f, or g-} prec d
sprintf_fmt = "%1" ++ (if prec < 0 then "" else '.':itos prec) ++ [c]
in
_ccall_ sprintf sprintf_here sprintf_fmt d >>
stToIO (freezeCharArray sprintf_here) >>= \ (ByteArray _ arr#) ->
stToIO (freezeCharArray sprintf_here) >>= \ (ByteArray _ _ arr#) ->
let
unpack :: Int# -> [Char]
unpack nh = case (ord# (indexCharArray# arr# nh)) of
......
......@@ -62,7 +62,7 @@ createPatBuffer :: Bool -> IO PatBuffer
createPatBuffer insensitive
= _casm_ ``%r = (int)sizeof(struct re_pattern_buffer);'' >>= \ sz ->
stToIO (newCharArray (0::Int,sz)) >>= \ (MutableByteArray _ pbuf#) ->
stToIO (newCharArray (0::Int,sz)) >>= \ (MutableByteArray _ _ pbuf#) ->
let
pbuf = PatBuffer# pbuf#
in
......
......@@ -109,7 +109,7 @@ getGroups = do
else
syserr "getGroups"
where
extract (ByteArray _ barr#) (I# n#) =
extract (ByteArray _ _ barr#) (I# n#) =
case indexIntArray# barr# n# of
r# -> (I# r#)
#endif
......
......@@ -62,7 +62,7 @@ getCPUTime = do
getCPUTime :: IO Integer
getCPUTime =
stToIO (newIntArray ((0::Int),3)) >>= \ marr ->
stToIO (unsafeFreezeByteArray marr) >>= \ barr@(ByteArray _ frozen#) ->
stToIO (unsafeFreezeByteArray marr) >>= \ barr@(ByteArray _ _ frozen#) ->
primGetCPUTime barr >>= \ rc ->
if rc /= 0 then
return ((fromIntegral (I# (indexIntArray# frozen# 0#)) * 1000000000 +
......
......@@ -100,7 +100,7 @@ instance Ix Int where
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Int"
inRange (m,n) i = m <= i && i <= n
inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
----------------------------------------------------------------------
......
......@@ -53,10 +53,10 @@ accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a
\begin{code}
type IPr = (Int, Int)
data Ix ix => Array ix elt = Array (ix,ix) (Array# elt)
data Ix ix => ByteArray ix = ByteArray (ix,ix) ByteArray#
data Ix ix => MutableArray s ix elt = MutableArray (ix,ix) (MutableArray# s elt)
data Ix ix => MutableByteArray s ix = MutableByteArray (ix,ix) (MutableByteArray# s)
data Ix ix => Array ix elt = Array ix ix (Array# elt)
data Ix ix => ByteArray ix = ByteArray ix ix ByteArray#
data Ix ix => MutableArray s ix elt = MutableArray ix ix (MutableArray# s elt)
data Ix ix => MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
instance CCallable (MutableByteArray s ix)
instance CCallable (MutableByteArray# s)
......@@ -72,11 +72,11 @@ instance Eq (MutableVar s a) where
-- just pointer equality on arrays:
instance Eq (MutableArray s ix elt) where
MutableArray _ arr1# == MutableArray _ arr2#
MutableArray _ _ arr1# == MutableArray _ _ arr2#
= sameMutableArray# arr1# arr2#
instance Eq (MutableByteArray s ix) where
MutableByteArray _ arr1# == MutableByteArray _ arr2#
MutableByteArray _ _ arr1# == MutableByteArray _ _ arr2#
= sameMutableByteArray# arr1# arr2#
\end{code}
......@@ -111,10 +111,10 @@ writeVar (MutableVar var#) val = ST $ \ s# ->
"array", "!" and "bounds" are basic; the rest can be defined in terms of them
\begin{code}
bounds (Array b _) = b
bounds (Array l u _) = (l,u)
(Array bounds arr#) ! i
= let n# = case (index bounds i) of { I# x -> x } -- index fails if out of range
(Array l u arr#) ! i
= let n# = case (index (l,u) i) of { I# x -> x } -- index fails if out of range
in
case (indexArray# arr# n#) of
(# v #) -> v
......@@ -137,8 +137,9 @@ fill ixs marr (i,v) next = \s1 -> case index ixs i of { I# n ->
done :: Ix ix => (ix,ix) -> MutableArray# s elt
-> STRep s (Array ix elt)
{-# INLINE done #-}
done ixs marr = \s1 -> case unsafeFreezeArray# marr s1 of { (# s2, arr #) ->
(# s2, Array ixs arr #) }
done (l,u) marr = \s1 ->
case unsafeFreezeArray# marr s1 of { (# s2, arr #) ->
(# s2, Array l u arr #) }
arrEleBottom :: a
arrEleBottom = error "(Array.!): undefined array element"
......@@ -231,46 +232,46 @@ newCharArray, newIntArray, newWordArray, newAddrArray, newFloatArray, newDoubleA
{-# SPECIALIZE newFloatArray :: IPr -> ST s (MutableByteArray s Int) #-}
{-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
newArray ixs init = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
case (newArray# n# init s#) of { (# s2#, arr# #) ->
(# s2#, MutableArray ixs arr# #) }}
newArray (l,u) init = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case (newArray# n# init s#) of { (# s2#, arr# #) ->
(# s2#, MutableArray l u arr# #) }}
newCharArray ixs = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
newCharArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case (newCharArray# n# s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray ixs barr# #) }}
(# s2#, MutableByteArray l u barr# #) }}
newIntArray ixs = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
newIntArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case (newIntArray# n# s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray ixs barr# #) }}
(# s2#, MutableByteArray l u barr# #) }}
newWordArray ixs = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
newWordArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case (newWordArray# n# s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray ixs barr# #) }}
(# s2#, MutableByteArray l u barr# #) }}
newAddrArray ixs = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
newAddrArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case (newAddrArray# n# s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray ixs barr# #) }}
(# s2#, MutableByteArray l u barr# #) }}
newFloatArray ixs = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
newFloatArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case (newFloatArray# n# s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray ixs barr# #) }}
(# s2#, MutableByteArray l u barr# #) }}
newDoubleArray ixs = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
newDoubleArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case (newDoubleArray# n# s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray ixs barr# #) }}
(# s2#, MutableByteArray l u barr# #) }}
boundsOfArray :: Ix ix => MutableArray s ix elt -> (ix, ix)
{-# SPECIALIZE boundsOfArray :: MutableArray s Int elt -> IPr #-}
boundsOfArray (MutableArray ixs _) = ixs
boundsOfArray (MutableArray l u _) = (l,u)
readArray :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
......@@ -290,38 +291,38 @@ readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
--NO:{-# SPECIALIZE readFloatArray :: MutableByteArray s Int -> Int -> ST s Float #-}
{-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
readArray (MutableArray ixs arr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
case readArray# arr# n# s# of { (# s2#, r #) ->
readArray (MutableArray l u arr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readArray# arr# n# s# of { (# s2#, r #) ->
(# s2#, r #) }}
readCharArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
readCharArray (MutableByteArray l u barr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readCharArray# barr# n# s# of { (# s2#, r# #) ->
(# s2#, C# r# #) }}
readIntArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readIntArray# barr# n# s# of { (# s2#, r# #) ->
(# s2#, I# r# #) }}
readWordArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
readWordArray (MutableByteArray l u barr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readWordArray# barr# n# s# of { (# s2#, r# #) ->
(# s2#, W# r# #) }}
readAddrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
readAddrArray (MutableByteArray l u barr#) n = ST $ \ s# ->
case (index (l,u) n) of { I# n# ->
case readAddrArray# barr# n# s# of { (# s2#, r# #) ->
(# s2#, A# r# #) }}