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