-- 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)]
)
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
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
\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}
\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}
\begin{code}
sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
-sizeofMutableByteArray (MutableByteArray _ arr#) =
+sizeofMutableByteArray (MutableByteArray _ _ arr#) =
case (sizeofMutableByteArray# arr#) of
i# -> (I# i#)
\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
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#) #)
-- 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#) #) }}
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# =
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# , () #)
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# #) ->
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#) #)
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# =
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# , () #)
\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
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
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}
-- 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
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#
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
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 _)
-- 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
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#)
-- 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#
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
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
\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}
| 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
if res ==# 0# then False else True
))
where
- ba = ByteArray (0, I# (len -# 1#)) bs
+ ba = ByteArray 0 (I# (len -# 1#)) bs
-----------------------
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
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
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
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
= 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
-- 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
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
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
else
syserr "getGroups"
where
- extract (ByteArray _ barr#) (I# n#) =
+ extract (ByteArray _ _ barr#) (I# n#) =
case indexIntArray# barr# n# of
r# -> (I# r#)
#endif
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 +
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
----------------------------------------------------------------------
\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)
-- 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}
"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
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"
{-# 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
--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# #) }}
-readFloatArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
+readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
+ case (index (l,u) n) of { I# n# ->
case readFloatArray# barr# n# s# of { (# s2#, r# #) ->
(# s2#, F# r# #) }}
-readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
+readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
+ case (index (l,u) n) of { I# n# ->
case readDoubleArray# barr# n# s# of { (# s2#, r# #) ->
(# s2#, D# r# #) }}
--NO:{-# SPECIALIZE indexFloatArray :: ByteArray Int -> Int -> Float #-}
{-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
-indexCharArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
+indexCharArray (ByteArray l u barr#) n
+ = case (index (l,u) n) of { I# n# ->
case indexCharArray# barr# n# of { r# ->
(C# r#)}}
-indexIntArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
+indexIntArray (ByteArray l u barr#) n
+ = case (index (l,u) n) of { I# n# ->
case indexIntArray# barr# n# of { r# ->
(I# r#)}}
-indexWordArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
+indexWordArray (ByteArray l u barr#) n
+ = case (index (l,u) n) of { I# n# ->
case indexWordArray# barr# n# of { r# ->
(W# r#)}}
-indexAddrArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
+indexAddrArray (ByteArray l u barr#) n
+ = case (index (l,u) n) of { I# n# ->
case indexAddrArray# barr# n# of { r# ->
(A# r#)}}
-indexFloatArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
+indexFloatArray (ByteArray l u barr#) n
+ = case (index (l,u) n) of { I# n# ->
case indexFloatArray# barr# n# of { r# ->
(F# r#)}}
-indexDoubleArray (ByteArray ixs barr#) n
- = case (index ixs n) of { I# n# ->
+indexDoubleArray (ByteArray l u barr#) n
+ = case (index (l,u) n) of { I# n# ->
case indexDoubleArray# barr# n# of { r# ->
(D# r#)}}
--NO:{-# SPECIALIZE writeFloatArray :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
{-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
-writeArray (MutableArray ixs arr#) n ele = ST $ \ s# ->
- case index ixs n of { I# n# ->
- case writeArray# arr# n# ele s# of { s2# ->
+writeArray (MutableArray l u arr#) n ele = ST $ \ s# ->
+ case index (l,u) n of { I# n# ->
+ case writeArray# arr# n# ele s# of { s2# ->
(# s2#, () #) }}
-writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
+writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
+ case index (l,u) n of { I# n# ->
case writeCharArray# barr# n# ele s# of { s2# ->
(# s2#, () #) }}
-writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
+writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
+ case index (l,u) n of { I# n# ->
case writeIntArray# barr# n# ele s# of { s2# ->
(# s2#, () #) }}
-writeWordArray (MutableByteArray ixs barr#) n (W# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
+writeWordArray (MutableByteArray l u barr#) n (W# ele) = ST $ \ s# ->
+ case index (l,u) n of { I# n# ->
case writeWordArray# barr# n# ele s# of { s2# ->
(# s2#, () #) }}
-writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
+writeAddrArray (MutableByteArray l u barr#) n (A# ele) = ST $ \ s# ->
+ case index (l,u) n of { I# n# ->
case writeAddrArray# barr# n# ele s# of { s2# ->
(# s2#, () #) }}
-writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
+writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
+ case index (l,u) n of { I# n# ->
case writeFloatArray# barr# n# ele s# of { s2# ->
(# s2#, () #) }}
-writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ s# ->
- case (index ixs n) of { I# n# ->
+writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
+ case index (l,u) n of { I# n# ->
case writeDoubleArray# barr# n# ele s# of { s2# ->
(# s2#, () #) }}
\end{code}
#-}
{-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
-freezeArray (MutableArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
+freezeArray (MutableArray l u arr#) = ST $ \ s# ->
+ case rangeSize (l,u) of { I# n# ->
case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, Array ixs frozen# #) }}
+ (# s2#, Array l u frozen# #) }}
where
freeze :: MutableArray# s ele -- the thing
-> Int# -- size of thing to be frozen
copy (cur# +# 1#) end# from# to# s2#
}}
-freezeCharArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
+freezeCharArray (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
copy (cur# +# 1#) end# from# to# s3#
}}
-freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
+freezeIntArray (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
copy (cur# +# 1#) end# from# to# s3#
}}
-freezeWordArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
+freezeWordArray (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
copy (cur# +# 1#) end# from# to# s3#
}}
-freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
+freezeAddrArray (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
{-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
#-}
-unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ s# ->
+unsafeFreezeArray (MutableArray l u arr#) = ST $ \ s# ->
case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
- (# s2#, Array ixs frozen# #) }
+ (# s2#, Array l u frozen# #) }
-unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ s# ->
+unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray ixs frozen# #) }
+ (# s2#, ByteArray l u frozen# #) }
--This takes a immutable array, and copies it into a mutable array, in a
#-}
thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
-thawArray (Array ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
+thawArray (Array l u arr#) = ST $ \ s# ->
+ case rangeSize (l,u) of { I# n# ->
case thaw arr# n# s# of { (# s2#, thawed# #) ->
- (# s2#, MutableArray ixs thawed# #)}}
+ (# s2#, MutableArray l u thawed# #)}}
where
thaw :: Array# ele -- the thing
-> Int# -- size of thing to be thawed
-- (& representation) of an immutable array. And placing a
-- proof obligation on the programmer.
unsafeThawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
-unsafeThawArray (Array ixs arr#) = ST $ \ s# ->
+unsafeThawArray (Array l u arr#) = ST $ \ s# ->
case unsafeThawArray# arr# s# of
- (# s2#, marr# #) -> (# s2#, MutableArray ixs marr# #)
+ (# s2#, marr# #) -> (# s2#, MutableArray l u marr# #)
\end{code}
freezeFloatArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeFloatArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
+freezeFloatArray (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
copy (cur# +# 1#) from# to# s3#
}}
-freezeDoubleArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
+freezeDoubleArray (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
reportError :: Bool -> String -> IO ()
reportError bombOut str = do
(hFlush stdout) `catchException` (\ _ -> return ())
- let bs@(ByteArray (_,len) _) = packString str
+ let bs@(ByteArray _ len _) = packString str
writeErrString addrOf_ErrorHdrHook bs len
if bombOut then
stg_exit 1
\begin{code}
unpackCStringBA :: ByteArray Int -> [Char]
-unpackCStringBA (ByteArray (l@(I# l#),u@(I# u#)) bytes)
+unpackCStringBA (ByteArray l@(I# l#) u@(I# u#) bytes)
| l > u = []
| otherwise = unpackCStringBA# bytes (u# -# l# +# 1#)
ch = indexCharArray# bytes nh
unpackNBytesBA :: ByteArray Int -> Int -> [Char]
-unpackNBytesBA (ByteArray (l,u) bytes) i
+unpackNBytesBA (ByteArray l u bytes) i
= unpackNBytesBA# bytes len#
where
len# = case max 0 (min i len) of I# v# -> v#
\begin{code}
packCString# :: [Char] -> ByteArray#
-packCString# str = case (packString str) of { ByteArray _ bytes -> bytes }
+packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
packString :: [Char] -> ByteArray Int
packString str = runST (packStringST str)
new_ps_array size = ST $ \ s ->
case (newCharArray# size s) of { (# s2#, barr# #) ->
- (# s2#, MutableByteArray bot barr# #) }
+ (# s2#, MutableByteArray bot bot barr# #) }
where
bot = error "new_ps_array"
-write_ps_array (MutableByteArray _ barr#) n ch = ST $ \ s# ->
+write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
case writeCharArray# barr# n ch s# of { s2# ->
(# s2#, () #) }
-- same as unsafeFreezeByteArray
-freeze_ps_array (MutableByteArray _ arr#) len# = ST $ \ s# ->
+freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray (0,I# len#) frozen# #) }
+ (# s2#, ByteArray 0 (I# len#) frozen# #) }
\end{code}
malloc1 :: IO (MutableByteArray RealWorld Int)
malloc1 = IO $ \ s# ->
case newIntArray# 1# s# of
- (# s2#, barr# #) -> (# s2#, MutableByteArray bottom barr# #)
-
-bottom :: (Int,Int)
-bottom = error "Time.bottom"
+ (# s2#, barr# #) -> (# s2#, MutableByteArray bot bot barr# #)
+ where
+ bot = error "Time.malloc1"
-- The C routine fills in an unsigned word. We don't have
-- `unsigned2Integer#,' so we freeze the data bits and use them
-- although (J# 1# (ptr to 0#)) is probably acceptable to gmp.
cvtUnsigned :: MutableByteArray RealWorld Int -> IO Integer
-cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# ->
+cvtUnsigned (MutableByteArray _ _ arr#) = IO $ \ s# ->
case readIntArray# arr# 0# s# of
(# s2#, r# #) | r# ==# 0# -> (# s2#, 0 #)
| otherwise ->
allocWords (I# size#) = IO $ \ s# ->
case newIntArray# size# s# of
(# s2#, barr# #) ->
- (# s2#, MutableByteArray bot barr# #)
+ (# s2#, MutableByteArray bot bot barr# #)
where
bot = error "Time.allocWords"
#endif
projects / ghc-hetmet.git / commitdiff