compiler/main/BreakArray.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Break Arrays in the IO monad
   4 -- Entries in the array are Word sized
   5 --
   6 -- Conceptually, a zero-indexed IOArray of Bools, initially False.
   7 -- They're represented as Words with 0==False, 1==True.
   8 -- They're used to determine whether GHCI breakpoints are on or off.
   9 --
  10 -- (c) The University of Glasgow 2007
  11 --
  12 -----------------------------------------------------------------------------
  13
  14 module BreakArray
  15   ( BreakArray
  16 #ifdef GHCI
  17       (BA)  -- constructor is exported only for ByteCodeGen
  18 #endif
  19   , newBreakArray
  20 #ifdef GHCI
  21   , getBreak
  22   , setBreakOn
  23   , setBreakOff
  24   , showBreakArray
  25 #endif
  26   ) where
  27 #ifdef GHCI
  28 import GHC.Exts
  29 #if __GLASGOW_HASKELL__ >= 611
  30 import GHC.IO ( IO(..) )
  31 #else
  32 import GHC.IOBase ( IO(..) )
  33 #endif
  34 import GHC.Word
  35 import Constants
  36
  37 data BreakArray = BA (MutableByteArray# RealWorld)
  38
  39 breakOff, breakOn :: Word
  40 breakOn  = 1
  41 breakOff = 0
  42
  43 -- XXX crude
  44 showBreakArray :: BreakArray -> IO ()
  45 showBreakArray array = do
  46    let loop count sz
  47           | count == sz = return ()
  48           | otherwise = do
  49                val <- readBreakArray array count
  50                putStr $ " " ++ show val
  51                loop (count + 1) sz
  52    loop 0 (size array)
  53    putStr "\n"
  54
  55 setBreakOn :: BreakArray -> Int -> IO Bool
  56 setBreakOn array index
  57    | safeIndex array index = do
  58         writeBreakArray array index breakOn
  59         return True
  60    | otherwise = return False
  61
  62 setBreakOff :: BreakArray -> Int -> IO Bool
  63 setBreakOff array index
  64    | safeIndex array index = do
  65         writeBreakArray array index breakOff
  66         return True
  67    | otherwise = return False
  68
  69 getBreak :: BreakArray -> Int -> IO (Maybe Word)
  70 getBreak array index
  71    | safeIndex array index = do
  72         val <- readBreakArray array index
  73         return $ Just val
  74    | otherwise = return Nothing
  75
  76 safeIndex :: BreakArray -> Int -> Bool
  77 safeIndex array index = index < size array && index >= 0
  78
  79 size :: BreakArray -> Int
  80 size (BA array) = (I# (sizeofMutableByteArray# array)) `div` wORD_SIZE
  81
  82 allocBA :: Int -> IO BreakArray
  83 allocBA (I# sz) = IO $ \s1 ->
  84   case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
  85
  86 -- create a new break array and initialise elements to zero
  87 newBreakArray :: Int -> IO BreakArray
  88 newBreakArray entries@(I# sz) = do
  89    BA array <- allocBA (entries * wORD_SIZE)
  90    case breakOff of
  91       W# off -> do    -- Todo: there must be a better way to write zero as a Word!
  92          let loop n
  93                 | n ==# sz = return ()
  94                 | otherwise = do
  95                      writeBA# array n off
  96                      loop (n +# 1#)
  97          loop 0#
  98    return $ BA array
  99
 100 writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
 101 writeBA# array i word = IO $ \s ->
 102   case writeWordArray# array i word s of { s -> (# s, () #) }
 103
 104 writeBreakArray :: BreakArray -> Int -> Word -> IO ()
 105 writeBreakArray (BA array) (I# i) (W# word) = writeBA# array i word
 106
 107 readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word
 108 readBA# array i = IO $ \s ->
 109    case readWordArray# array i s of { (# s, c #) -> (# s, W# c #) }
 110
 111 readBreakArray :: BreakArray -> Int -> IO Word
 112 readBreakArray (BA array) (I# i) = readBA# array i
 113
 114 #else /* GHCI */
 115 --stub implementation to make main/, etc., code happier.
 116 --IOArray and IOUArray are increasingly non-portable,
 117 --still don't have quite the same interface, and (for GHCI)
 118 --presumably have a different representation.
 119 data BreakArray = Unspecified
 120 newBreakArray :: Int -> IO BreakArray
 121 newBreakArray _ = return Unspecified
 122 #endif /* GHCI */
 123