Always enable the external interpreter
[ghc.git] / libraries / ghci / GHCi / BreakArray.hs
1 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
2 {-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
3
4 -------------------------------------------------------------------------------
5 --
6 -- (c) The University of Glasgow 2007
7 --
8 -- | Break Arrays
9 --
10 -- An array of bytes, indexed by a breakpoint number (breakpointId in Tickish)
11 -- There is one of these arrays per module.
12 --
13 -- Each byte is
14 -- 1 if the corresponding breakpoint is enabled
15 -- 0 otherwise
16 --
17 -------------------------------------------------------------------------------
18
19 module GHCi.BreakArray
20 (
21 BreakArray
22 (BA) -- constructor is exported only for ByteCodeGen
23 , newBreakArray
24 , getBreak
25 , setBreakOn
26 , setBreakOff
27 , showBreakArray
28 ) where
29
30 import Prelude -- See note [Why do we import Prelude here?]
31 import Control.Monad
32 import Data.Word
33 import GHC.Word
34
35 import GHC.Exts
36 import GHC.IO ( IO(..) )
37 import System.IO.Unsafe ( unsafeDupablePerformIO )
38
39 data BreakArray = BA (MutableByteArray# RealWorld)
40
41 breakOff, breakOn :: Word8
42 breakOn = 1
43 breakOff = 0
44
45 showBreakArray :: BreakArray -> IO ()
46 showBreakArray array = do
47 forM_ [0 .. (size array - 1)] $ \i -> do
48 val <- readBreakArray array i
49 putStr $ ' ' : show val
50 putStr "\n"
51
52 setBreakOn :: BreakArray -> Int -> IO Bool
53 setBreakOn array index
54 | safeIndex array index = do
55 writeBreakArray array index breakOn
56 return True
57 | otherwise = return False
58
59 setBreakOff :: BreakArray -> Int -> IO Bool
60 setBreakOff array index
61 | safeIndex array index = do
62 writeBreakArray array index breakOff
63 return True
64 | otherwise = return False
65
66 getBreak :: BreakArray -> Int -> IO (Maybe Word8)
67 getBreak array index
68 | safeIndex array index = do
69 val <- readBreakArray array index
70 return $ Just val
71 | otherwise = return Nothing
72
73 safeIndex :: BreakArray -> Int -> Bool
74 safeIndex array index = index < size array && index >= 0
75
76 size :: BreakArray -> Int
77 size (BA array) = size
78 where
79 -- We want to keep this operation pure. The mutable byte array
80 -- is never resized so this is safe.
81 size = unsafeDupablePerformIO $ sizeofMutableByteArray array
82
83 sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int
84 sizeofMutableByteArray arr =
85 IO $ \s -> case getSizeofMutableByteArray# arr s of
86 (# s', n# #) -> (# s', I# n# #)
87
88 allocBA :: Int -> IO BreakArray
89 allocBA (I# sz) = IO $ \s1 ->
90 case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
91
92 -- create a new break array and initialise elements to zero
93 newBreakArray :: Int -> IO BreakArray
94 newBreakArray entries@(I# sz) = do
95 BA array <- allocBA entries
96 case breakOff of
97 W8# off -> do
98 let loop n | isTrue# (n ==# sz) = return ()
99 | otherwise = do writeBA# array n off; loop (n +# 1#)
100 loop 0#
101 return $ BA array
102
103 writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
104 writeBA# array i word = IO $ \s ->
105 case writeWord8Array# array i word s of { s -> (# s, () #) }
106
107 writeBreakArray :: BreakArray -> Int -> Word8 -> IO ()
108 writeBreakArray (BA array) (I# i) (W8# word) = writeBA# array i word
109
110 readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8
111 readBA# array i = IO $ \s ->
112 case readWord8Array# array i s of { (# s, c #) -> (# s, W8# c #) }
113
114 readBreakArray :: BreakArray -> Int -> IO Word8
115 readBreakArray (BA array) (I# i) = readBA# array i