compiler/main/BreakArray.hs

   1 --
   2 -- Break Arrays in the IO monad
   3 -- Entries in the array are Word sized
   4 --
   5
   6 module BreakArray
   7   ( BreakArray (BA)
   8   , newBreakArray
   9   , getBreak
  10   , setBreakOn
  11   , setBreakOff
  12   , showBreakArray
  13   ) where
  14
  15 import GHC.Exts
  16 import GHC.IOBase
  17 import GHC.Prim
  18 import GHC.Word
  19 import Constants
  20
  21 data BreakArray = BA (MutableByteArray# RealWorld)
  22
  23 breakOff, breakOn :: Word
  24 breakOn  = fromIntegral 1
  25 breakOff = fromIntegral 0
  26
  27 -- XXX crude
  28 showBreakArray :: BreakArray -> IO ()
  29 showBreakArray array = do
  30    let loop count sz
  31           | count == sz = return ()
  32           | otherwise = do
  33                val <- readBreakArray array count
  34                putStr $ " " ++ show val
  35                loop (count + 1) sz
  36    loop 0 (size array)
  37    putStr "\n"
  38
  39 setBreakOn :: BreakArray -> Int -> IO Bool
  40 setBreakOn array index
  41    | safeIndex array index = do
  42         writeBreakArray array index breakOn
  43         return True
  44    | otherwise = return False
  45
  46 setBreakOff :: BreakArray -> Int -> IO Bool
  47 setBreakOff array index
  48    | safeIndex array index = do
  49         writeBreakArray array index breakOff
  50         return True
  51    | otherwise = return False
  52
  53 getBreak :: BreakArray -> Int -> IO (Maybe Word)
  54 getBreak array index
  55    | safeIndex array index = do
  56         val <- readBreakArray array index
  57         return $ Just val
  58    | otherwise = return Nothing
  59
  60 safeIndex :: BreakArray -> Int -> Bool
  61 safeIndex array index = index < size array && index >= 0
  62
  63 size :: BreakArray -> Int
  64 size (BA array) = (I# (sizeofMutableByteArray# array)) `div` wORD_SIZE
  65
  66 allocBA :: Int -> IO BreakArray
  67 allocBA (I# sz) = IO $ \s1 ->
  68   case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
  69
  70 -- create a new break array and initialise elements to zero
  71 newBreakArray :: Int -> IO BreakArray
  72 newBreakArray entries@(I# sz) = do
  73    BA array <- allocBA (entries * wORD_SIZE)
  74    case breakOff of
  75       W# off -> do    -- Todo: there must be a better way to write zero as a Word!
  76          let loop n
  77                 | n ==# sz = return ()
  78                 | otherwise = do
  79                      writeBA# array n off
  80                      loop (n +# 1#)
  81          loop 0#
  82    return $ BA array
  83
  84 writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
  85 writeBA# array i word = IO $ \s ->
  86   case writeWordArray# array i word s of { s -> (# s, () #) }
  87
  88 writeBreakArray :: BreakArray -> Int -> Word -> IO ()
  89 writeBreakArray (BA array) (I# i) (W# word) = writeBA# array i word
  90
  91 readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word
  92 readBA# array i = IO $ \s ->
  93    case readWordArray# array i s of { (# s, c #) -> (# s, W# c #) }
  94
  95 readBreakArray :: BreakArray -> Int -> IO Word
  96 readBreakArray (BA array) (I# i) = readBA# array i