compiler/main/BreakArray.hs

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