diff --git a/ghc/compiler/deSugar/DsCCall.lhs b/ghc/compiler/deSugar/DsCCall.lhs
index ece7e71ab91b3425f22887e438a38d4ba4292b84..561553f4439c2d2f0e801d25e4290b176e935a4e 100644
--- a/ghc/compiler/deSugar/DsCCall.lhs
+++ b/ghc/compiler/deSugar/DsCCall.lhs
@@ -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
diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index f615dec8160f58c2ecf3828608260594a8d429bf..991767a4615f8b1330bdd80a6ab40ed8ca19d5dd 100644
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -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
diff --git a/ghc/lib/exts/ByteArray.lhs b/ghc/lib/exts/ByteArray.lhs
index 7f9615b6ded745177df343b8c35e7f73e691ca38..2ceb6b7ab51d1323e983e25f8e6ef892eef72716 100644
--- a/ghc/lib/exts/ByteArray.lhs
+++ b/ghc/lib/exts/ByteArray.lhs
@@ -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}
diff --git a/ghc/lib/exts/MutableArray.lhs b/ghc/lib/exts/MutableArray.lhs
index 7c8698228c24088d5f7e47b202bd391217cd137f..07dfd88d3fc9a5012e0d60ab5afbe436dbbe846a 100644
--- a/ghc/lib/exts/MutableArray.lhs
+++ b/ghc/lib/exts/MutableArray.lhs
@@ -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}
diff --git a/ghc/lib/misc/CString.lhs b/ghc/lib/misc/CString.lhs
index ca6dea6b7969ca8190e0c2875a50a44aaf5e04ad..3e0d2bff225d4b91d3267d1600aa69f4f9cca944 100644
--- a/ghc/lib/misc/CString.lhs
+++ b/ghc/lib/misc/CString.lhs
@@ -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
diff --git a/ghc/lib/misc/MD5.lhs b/ghc/lib/misc/MD5.lhs
index 5ddebe14825741d8aba6c6fd123396e6aa3344f0..cae5f2260b080305309504c3b2bae0ff50539db4 100644
--- a/ghc/lib/misc/MD5.lhs
+++ b/ghc/lib/misc/MD5.lhs
@@ -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#
diff --git a/ghc/lib/misc/PackedString.lhs b/ghc/lib/misc/PackedString.lhs
index ab6e592d5528ecee65278837e4474b549ea23696..50ffc1283d0b07fe39159913781ecf358843b85d 100644
--- a/ghc/lib/misc/PackedString.lhs
+++ b/ghc/lib/misc/PackedString.lhs
@@ -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
diff --git a/ghc/lib/misc/Printf.lhs b/ghc/lib/misc/Printf.lhs
index 8a0bb156af171904f888e6792685649138f1052d..18b837c79d16789a3332eef8d5a584bbf721c44a 100644
--- a/ghc/lib/misc/Printf.lhs
+++ b/ghc/lib/misc/Printf.lhs
@@ -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
diff --git a/ghc/lib/misc/Regex.lhs b/ghc/lib/misc/Regex.lhs
index 6cf3c95b144bc04bead454d00cb2386064a9036d..f087d105f9b131392bd3ab11e84b9d34df1e1802 100644
--- a/ghc/lib/misc/Regex.lhs
+++ b/ghc/lib/misc/Regex.lhs
@@ -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
diff --git a/ghc/lib/posix/PosixProcEnv.lhs b/ghc/lib/posix/PosixProcEnv.lhs
index bd0394adf29c8b2bd56f30b0a52ec1455355b42d..659ea9e5a45a53bd4ef49fab2ba5062d29ba15e5 100644
--- a/ghc/lib/posix/PosixProcEnv.lhs
+++ b/ghc/lib/posix/PosixProcEnv.lhs
@@ -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
diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs
index 74f3668e4d6f4eb6c03ee45f061949665dcf82c7..8dfc784edbda71df9e30cd6163ea322fbda7ceb6 100644
--- a/ghc/lib/std/CPUTime.lhs
+++ b/ghc/lib/std/CPUTime.lhs
@@ -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 +
diff --git a/ghc/lib/std/Ix.lhs b/ghc/lib/std/Ix.lhs
index 1ed8bc256709139687b1c52be37eba0546cc1387..1715448fadbcea41d6d0842e88f3fb4a9778fcc7 100644
--- a/ghc/lib/std/Ix.lhs
+++ b/ghc/lib/std/Ix.lhs
@@ -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
----------------------------------------------------------------------
diff --git a/ghc/lib/std/PrelArr.lhs b/ghc/lib/std/PrelArr.lhs
index 8165fac1ff80fa0f0905e3c3dddccacf34bdae36..dea699a9002e99a5b46968391c6d13b11a8f6848 100644
--- a/ghc/lib/std/PrelArr.lhs
+++ b/ghc/lib/std/PrelArr.lhs
@@ -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# #) }}
-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# #) }}
@@ -339,33 +340,33 @@ indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
--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#)}}
@@ -386,38 +387,38 @@ writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
--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}
@@ -441,10 +442,10 @@ freezeAddrArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
#-}
{-# 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
@@ -473,10 +474,10 @@ freezeArray (MutableArray ixs arr#) = ST $ \ s# ->
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
@@ -503,10 +504,10 @@ freezeCharArray (MutableByteArray ixs arr#) = ST $ \ s# ->
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
@@ -533,10 +534,10 @@ freezeIntArray (MutableByteArray ixs arr#) = ST $ \ s# ->
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
@@ -562,10 +563,10 @@ freezeWordArray (MutableByteArray ixs arr#) = ST $ \ s# ->
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
@@ -598,13 +599,13 @@ unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
{-# 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
@@ -615,10 +616,10 @@ unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ s# ->
#-}
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
@@ -650,7 +651,7 @@ thawArray (Array ixs arr#) = ST $ \ s# ->
-- (& 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}
diff --git a/ghc/lib/std/PrelArrExtra.lhs b/ghc/lib/std/PrelArrExtra.lhs
index a09f051f317f48f8b80b1a6452e2a71e622b1556..7c267fccc4c3ccf1e5187dc153d576131da488dd 100644
--- a/ghc/lib/std/PrelArrExtra.lhs
+++ b/ghc/lib/std/PrelArrExtra.lhs
@@ -22,10 +22,10 @@ import PrelGHC
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
@@ -52,10 +52,10 @@ freezeFloatArray (MutableByteArray ixs arr#) = ST $ \ s# ->
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
diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index 4e60b23d8f49960103b38c5f1cd040f0ae582314..78fd97ad685a44b3e61f441d323dd8daae44ab4d 100644
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -1022,7 +1022,7 @@ reportStackOverflow bombOut = do
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
diff --git a/ghc/lib/std/PrelPack.lhs b/ghc/lib/std/PrelPack.lhs
index 5def5736dacb3fae72872610d5cd11465bd0c523..6351fca9b6970c825927a831327b9b137c05ef38 100644
--- a/ghc/lib/std/PrelPack.lhs
+++ b/ghc/lib/std/PrelPack.lhs
@@ -141,7 +141,7 @@ Converting byte arrays into list of chars:
\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#)
@@ -160,7 +160,7 @@ unpackCStringBA# bytes len
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#
@@ -190,7 +190,7 @@ Converting a list of chars into a packed @ByteArray@ representation.
\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)
@@ -232,18 +232,18 @@ freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
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}
diff --git a/ghc/lib/std/Time.lhs b/ghc/lib/std/Time.lhs
index 5b4b1d4bfac14560f57f390a6c511a1094247327..3ebfd43937233423570cdada8e691a3e2f21248f 100644
--- a/ghc/lib/std/Time.lhs
+++ b/ghc/lib/std/Time.lhs
@@ -210,10 +210,9 @@ cvtUnsigned arr = primReadInt64Array arr 0
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
@@ -221,7 +220,7 @@ bottom = error "Time.bottom"
-- 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 ->
@@ -428,7 +427,7 @@ allocWords :: Int -> IO (MutableByteArray RealWorld Int)
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