summaryrefslogtreecommitdiff
path: root/compiler/main/BreakArray.hs
diff options
context:
space:
mode:
authorDavid Terei <davidterei@gmail.com>2011-10-25 18:01:40 -0700
committerDavid Terei <davidterei@gmail.com>2011-11-01 01:11:50 -0700
commitcb4423b3582f79d425cd3c87f3ea37d2e358f93e (patch)
treed29d8b31a49a93d292f01d99f8f90efbbf9c342c /compiler/main/BreakArray.hs
parent7301bafe238971de8bdc8e772c79bbd9a0b7dd39 (diff)
downloadhaskell-cb4423b3582f79d425cd3c87f3ea37d2e358f93e.tar.gz
Some fixes to BreakArray
Diffstat (limited to 'compiler/main/BreakArray.hs')
-rw-r--r--compiler/main/BreakArray.hs107
1 files changed, 54 insertions, 53 deletions
diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs
index 4d2c07bba9..91e4c96c9a 100644
--- a/compiler/main/BreakArray.hs
+++ b/compiler/main/BreakArray.hs
@@ -1,32 +1,36 @@
------------------------------------------------------------------------------
+-------------------------------------------------------------------------------
--
--- Break Arrays in the IO monad
--- Entries in the array are Word sized
+-- | Break Arrays in the IO monad
--
--- Conceptually, a zero-indexed IOArray of Bools, initially False.
--- They're represented as Words with 0==False, 1==True.
+-- Entries in the array are Word sized Conceptually, a zero-indexed IOArray of
+-- Bools, initially False. They're represented as Words with 0==False, 1==True.
-- They're used to determine whether GHCI breakpoints are on or off.
--
-- (c) The University of Glasgow 2007
--
------------------------------------------------------------------------------
+-------------------------------------------------------------------------------
module BreakArray
- ( BreakArray
+ (
+ BreakArray
#ifdef GHCI
- (BA) -- constructor is exported only for ByteCodeGen
+ (BA) -- constructor is exported only for ByteCodeGen
#endif
- , newBreakArray
+ , newBreakArray
#ifdef GHCI
- , getBreak
- , setBreakOn
- , setBreakOff
- , showBreakArray
+ , getBreak
+ , setBreakOn
+ , setBreakOff
+ , showBreakArray
#endif
- ) where
+ ) where
+
#ifdef GHCI
+import Control.Monad
+
import GHC.Exts
import GHC.IO ( IO(..) )
+
import Constants
data BreakArray = BA (MutableByteArray# RealWorld)
@@ -35,38 +39,33 @@ breakOff, breakOn :: Word
breakOn = 1
breakOff = 0
--- XXX crude
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"
+ forM_ [0..(size array - 1)] $ \i -> do
+ val <- readBreakArray array i
+ putStr $ ' ' : show val
+ putStr "\n"
setBreakOn :: BreakArray -> Int -> IO Bool
setBreakOn array index
- | safeIndex array index = do
- writeBreakArray array index breakOn
- return True
- | otherwise = return False
+ | 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
+ | 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 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
@@ -76,43 +75,45 @@ 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 #) }
+ case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
-- create a new break array and initialise elements to zero
newBreakArray :: Int -> IO BreakArray
newBreakArray entries@(I# sz) = do
- BA array <- allocBA (entries * wORD_SIZE)
- case breakOff of
- W# off -> do -- Todo: there must be a better way to write zero as a Word!
- let loop n
- | n ==# sz = return ()
- | otherwise = do
- writeBA# array n off
- loop (n +# 1#)
- loop 0#
- return $ BA array
+ BA array <- allocBA (entries * wORD_SIZE)
+ case breakOff of
+ W# off -> do -- Todo: there must be a better way to write zero as a Word!
+ 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, () #) }
+ 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 #) }
+ 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 */
---stub implementation to make main/, etc., code happier.
---IOArray and IOUArray are increasingly non-portable,
---still don't have quite the same interface, and (for GHCI)
---presumably have a different representation.
+#else /* !GHCI */
+
+-- stub implementation to make main/, etc., code happier.
+-- IOArray and IOUArray are increasingly non-portable,
+-- still don't have quite the same interface, and (for GHCI)
+-- presumably have a different representation.
data BreakArray = Unspecified
+
newBreakArray :: Int -> IO BreakArray
newBreakArray _ = return Unspecified
+
#endif /* GHCI */