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 {-# OPTIONS -w #-}
  15 -- The above warning supression flag is a temporary kludge.
  16 -- While working on this module you are encouraged to remove it and fix
  17 -- any warnings in the module. See
  18 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  19 -- for details
  20
  21 module BreakArray
  22   ( BreakArray
  23 #ifdef GHCI
  24       (BA)  -- constructor is exported only for ByteCodeGen
  25 #endif
  26   , newBreakArray
  27 #ifdef GHCI
  28   , getBreak
  29   , setBreakOn
  30   , setBreakOff
  31   , showBreakArray
  32 #endif
  33   ) where
  34 #ifdef GHCI
  35 import GHC.Exts
  36 import GHC.IOBase
  37 import GHC.Word
  38 import Constants
  39
  40 data BreakArray = BA (MutableByteArray# RealWorld)
  41
  42 breakOff, breakOn :: Word
  43 breakOn  = 1
  44 breakOff = 0
  45
  46 -- XXX crude
  47 showBreakArray :: BreakArray -> IO ()
  48 showBreakArray array = do
  49    let loop count sz
  50           | count == sz = return ()
  51           | otherwise = do
  52                val <- readBreakArray array count
  53                putStr $ " " ++ show val
  54                loop (count + 1) sz
  55    loop 0 (size array)
  56    putStr "\n"
  57
  58 setBreakOn :: BreakArray -> Int -> IO Bool
  59 setBreakOn array index
  60    | safeIndex array index = do
  61         writeBreakArray array index breakOn
  62         return True
  63    | otherwise = return False
  64
  65 setBreakOff :: BreakArray -> Int -> IO Bool
  66 setBreakOff array index
  67    | safeIndex array index = do
  68         writeBreakArray array index breakOff
  69         return True
  70    | otherwise = return False
  71
  72 getBreak :: BreakArray -> Int -> IO (Maybe Word)
  73 getBreak array index
  74    | safeIndex array index = do
  75         val <- readBreakArray array index
  76         return $ Just val
  77    | otherwise = return Nothing
  78
  79 safeIndex :: BreakArray -> Int -> Bool
  80 safeIndex array index = index < size array && index >= 0
  81
  82 size :: BreakArray -> Int
  83 size (BA array) = (I# (sizeofMutableByteArray# array)) `div` wORD_SIZE
  84
  85 allocBA :: Int -> IO BreakArray
  86 allocBA (I# sz) = IO $ \s1 ->
  87   case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
  88
  89 -- create a new break array and initialise elements to zero
  90 newBreakArray :: Int -> IO BreakArray
  91 newBreakArray entries@(I# sz) = do
  92    BA array <- allocBA (entries * wORD_SIZE)
  93    case breakOff of
  94       W# off -> do    -- Todo: there must be a better way to write zero as a Word!
  95          let loop n
  96                 | n ==# sz = return ()
  97                 | otherwise = do
  98                      writeBA# array n off
  99                      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 writeWordArray# array i word s of { s -> (# s, () #) }
 106
 107 writeBreakArray :: BreakArray -> Int -> Word -> IO ()
 108 writeBreakArray (BA array) (I# i) (W# word) = writeBA# array i word
 109
 110 readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word
 111 readBA# array i = IO $ \s ->
 112    case readWordArray# array i s of { (# s, c #) -> (# s, W# c #) }
 113
 114 readBreakArray :: BreakArray -> Int -> IO Word
 115 readBreakArray (BA array) (I# i) = readBA# array i
 116
 117 #else /* GHCI */
 118 --stub implementation to make main/, etc., code happier.
 119 --IOArray and IOUArray are increasingly non-portable,
 120 --still don't have quite the same interface, and (for GHCI)
 121 --presumably have a different representation.
 122 data BreakArray = Unspecified
 123 newBreakArray :: Int -> IO BreakArray
 124 newBreakArray _ = return Unspecified
 125 #endif /* GHCI */
 126