Skip to content
Snippets Groups Projects
Commit 7adaf408 authored by Ben Gamari's avatar Ben Gamari :turtle:
Browse files

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.
parent b8a6d313
No related branches found
No related tags found
No related merge requests found
...@@ -1023,21 +1023,13 @@ instance MArray (STUArray s) Bool (ST s) where ...@@ -1023,21 +1023,13 @@ instance MArray (STUArray s) Bool (ST s) where
getNumElements (STUArray _ _ n _) = return n getNumElements (STUArray _ _ n _) = return n
{-# INLINE newArray #-} {-# INLINE newArray #-}
newArray (l,u) initialValue = ST $ \s1# -> newArray (l,u) initialValue = ST $ \s1# ->
case safeRangeSize (l,u) of { n@(I# n#) -> case safeRangeSize (l,u) of { n@(I# n#) ->
case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) -> case bOOL_SCALE n# of { nbytes# ->
case bOOL_WORD_SCALE n# of { n'# -> case newByteArray# nbytes# s1# of { (# s2#, marr# #) ->
#if __GLASGOW_HASKELL__ > 706 case setByteArray# marr# 0# nbytes# e# s2# of { s3# ->
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# ->
(# s3#, STUArray l u n marr# #) }}}} (# s3#, STUArray l u n marr# #) }}}}
where where
!(W# e#) = if initialValue then maxBound else 0 !(I# e#) = if initialValue then 0xff else 0x0
{-# INLINE unsafeNewArray_ #-} {-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE
{-# INLINE newArray_ #-} {-# INLINE newArray_ #-}
...@@ -1350,22 +1342,10 @@ instance MArray (STUArray s) Word64 (ST s) where ...@@ -1350,22 +1342,10 @@ instance MArray (STUArray s) Word64 (ST s) where
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Translation between elements and bytes -- Translation between elements and bytes
bOOL_SCALE, bOOL_WORD_SCALE, bOOL_SCALE, wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int# bOOL_SCALE n# =
bOOL_SCALE n# -- + 7 to handle case where n is not divisible by 8
| isTrue# (res# ># n#) = res# (n# +# 7#) `uncheckedIShiftRA#` 3#
| 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#)
wORD_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSWORD wORD_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSWORD
dOUBLE_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSDOUBLE dOUBLE_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSDOUBLE
fLOAT_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSFLOAT fLOAT_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSFLOAT
...@@ -1379,8 +1359,9 @@ safe_scale scale# n# ...@@ -1379,8 +1359,9 @@ safe_scale scale# n#
!res# = scale# *# n# !res# = scale# *# n#
!overflow = isTrue# (maxN# `divInt#` scale# <# n#) !overflow = isTrue# (maxN# `divInt#` scale# <# n#)
!(I# maxN#) = maxBound !(I# maxN#) = maxBound
{-# INLINE safe_scale #-}
-- | The index of the word which the given @Bool@ array elements falls within.
bOOL_INDEX :: Int# -> Int# bOOL_INDEX :: Int# -> Int#
#if SIZEOF_HSWORD == 4 #if SIZEOF_HSWORD == 4
bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5# bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment