module BreakArray
( BreakArray
#ifdef GHCI
(BA)
#endif
, newBreakArray
#ifdef GHCI
, getBreak
, setBreakOn
, setBreakOff
, showBreakArray
#endif
) where
#ifdef GHCI
import GHC.Exts
#if __GLASGOW_HASKELL__ >= 611
import GHC.IO ( IO(..) )
#else
import GHC.IOBase ( IO(..) )
#endif
import Constants
data BreakArray = BA (MutableByteArray# RealWorld)
breakOff, breakOn :: Word
breakOn = 1
breakOff = 0
showBreakArray :: BreakArray -> IO ()
showBreakArray array = do
let loop count sz
| count == sz = return ()
| otherwise = do
val <- readBreakArray array count
putStr $ " " ++ show val
loop (count + 1) sz
loop 0 (size array)
putStr "\n"
setBreakOn :: BreakArray -> Int -> IO Bool
setBreakOn array index
| safeIndex array index = do
writeBreakArray array index breakOn
return True
| otherwise = return False
setBreakOff :: BreakArray -> Int -> IO Bool
setBreakOff array index
| safeIndex array index = do
writeBreakArray array index breakOff
return True
| otherwise = return False
getBreak :: BreakArray -> Int -> IO (Maybe Word)
getBreak array index
| safeIndex array index = do
val <- readBreakArray array index
return $ Just val
| otherwise = return Nothing
safeIndex :: BreakArray -> Int -> Bool
safeIndex array index = index < size array && index >= 0
size :: BreakArray -> Int
size (BA array) = (I# (sizeofMutableByteArray# array)) `div` wORD_SIZE
allocBA :: Int -> IO BreakArray
allocBA (I# sz) = IO $ \s1 ->
case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
newBreakArray :: Int -> IO BreakArray
newBreakArray entries@(I# sz) = do
BA array <- allocBA (entries * wORD_SIZE)
case breakOff of
W# off -> do
let loop n
| n ==# sz = return ()
| otherwise = do
writeBA# array n off
loop (n +# 1#)
loop 0#
return $ BA array
writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
writeBA# array i word = IO $ \s ->
case writeWordArray# array i word s of { s -> (# s, () #) }
writeBreakArray :: BreakArray -> Int -> Word -> IO ()
writeBreakArray (BA array) (I# i) (W# word) = writeBA# array i word
readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word
readBA# array i = IO $ \s ->
case readWordArray# array i s of { (# s, c #) -> (# s, W# c #) }
readBreakArray :: BreakArray -> Int -> IO Word
readBreakArray (BA array) (I# i) = readBA# array i
#else /* GHCI */
data BreakArray = Unspecified
newBreakArray :: Int -> IO BreakArray
newBreakArray _ = return Unspecified
#endif /* GHCI */