From 7adaf408cf24e420083f88ecd5b8d7bd7d0e5512 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Tue, 7 Feb 2017 21:32:29 -0500
Subject: [PATCH] Fix and simplify handling of Bool arrays
No overflow check is necessary in the case of Bool arrays since the array size
is actually smaller than the number of elements it contains. Moreover, we can
use setByteArray# to initialize the array.
---
Data/Array/Base.hs | 41 +++++++++++------------------------------
1 file changed, 11 insertions(+), 30 deletions(-)
diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index 3bf861f3..36db53fa 100644
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -1023,21 +1023,13 @@ instance MArray (STUArray s) Bool (ST s) where
getNumElements (STUArray _ _ n _) = return n
{-# INLINE newArray #-}
newArray (l,u) initialValue = ST $ \s1# ->
- case safeRangeSize (l,u) of { n@(I# n#) ->
- case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
- case bOOL_WORD_SCALE n# of { n'# ->
-#if __GLASGOW_HASKELL__ > 706
- let loop i# s3# | isTrue# (i# ==# n'#) = s3#
-#else
- let loop i# s3# | i# ==# n'# = s3#
-#endif
- | otherwise =
- case writeWordArray# marr# i# e# s3# of { s4# ->
- loop (i# +# 1#) s4# } in
- case loop 0# s2# of { s3# ->
+ case safeRangeSize (l,u) of { n@(I# n#) ->
+ case bOOL_SCALE n# of { nbytes# ->
+ case newByteArray# nbytes# s1# of { (# s2#, marr# #) ->
+ case setByteArray# marr# 0# nbytes# e# s2# of { s3# ->
(# s3#, STUArray l u n marr# #) }}}}
where
- !(W# e#) = if initialValue then maxBound else 0
+ !(I# e#) = if initialValue then 0xff else 0x0
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE
{-# INLINE newArray_ #-}
@@ -1350,22 +1342,10 @@ instance MArray (STUArray s) Word64 (ST s) where
-----------------------------------------------------------------------------
-- Translation between elements and bytes
-bOOL_SCALE, bOOL_WORD_SCALE,
- wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
-bOOL_SCALE n#
- | isTrue# (res# ># n#) = res#
- | otherwise = error $ "Data.Array.Base.bOOL_SCALE: Overflow; n: "
- ++ show (I# n#) ++ ", res: " ++ show (I# n#)
- where
- !(I# last#) = SIZEOF_HSWORD * 8 - 1
- !res# = (n# +# last#) `uncheckedIShiftRA#` 3#
-bOOL_WORD_SCALE n#
- | isTrue# (res# ># n#) = res#
- | otherwise = error $ "Data.Array.Base.bOOL_WORD_SCALE: Overflow; n: "
- ++ show (I# n#) ++ ", res: " ++ show (I# n#)
- where
- !(I# last#) = SIZEOF_HSWORD * 8 - 1
- !res# = bOOL_INDEX (n# +# last#)
+bOOL_SCALE, wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
+bOOL_SCALE n# =
+ -- + 7 to handle case where n is not divisible by 8
+ (n# +# 7#) `uncheckedIShiftRA#` 3#
wORD_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSWORD
dOUBLE_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSDOUBLE
fLOAT_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSFLOAT
@@ -1379,8 +1359,9 @@ safe_scale scale# n#
!res# = scale# *# n#
!overflow = isTrue# (maxN# `divInt#` scale# <# n#)
!(I# maxN#) = maxBound
+{-# INLINE safe_scale #-}
-
+-- | The index of the word which the given @Bool@ array elements falls within.
bOOL_INDEX :: Int# -> Int#
#if SIZEOF_HSWORD == 4
bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#
--
GitLab