never executed always true always false

    1 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
    2 {-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
    3 
    4 -------------------------------------------------------------------------------
    5 --
    6 -- (c) The University of Glasgow 2007
    7 --
    8 -- | Break Arrays
    9 --
   10 -- An array of words, indexed by a breakpoint number (breakpointId in Tickish)
   11 -- containing the ignore count for every breakpopint.
   12 -- There is one of these arrays per module.
   13 --
   14 -- For each word with value n:
   15 --   n > 1  : the corresponding breakpoint is enabled. Next time the bp is hit,
   16 --            GHCi will decrement the ignore count and continue processing.
   17 --   n == 0 : The breakpoint is enabled, GHCi will stop next time it hits
   18 --            this breakpoint.
   19 --   n == -1: This breakpoint is disabled.
   20 --   n < -1 : Not used.
   21 --
   22 -------------------------------------------------------------------------------
   23 
   24 module GHCi.BreakArray
   25     (
   26       BreakArray
   27           (BA) -- constructor is exported only for GHC.StgToByteCode
   28     , newBreakArray
   29     , getBreak
   30     , setupBreakpoint
   31     , breakOn
   32     , breakOff
   33     , showBreakArray
   34     ) where
   35 
   36 import Prelude -- See note [Why do we import Prelude here?]
   37 import Control.Monad
   38 
   39 import GHC.Exts
   40 import GHC.IO ( IO(..) )
   41 import System.IO.Unsafe ( unsafeDupablePerformIO )
   42 
   43 #include "MachDeps.h"
   44 
   45 data BreakArray = BA (MutableByteArray# RealWorld)
   46 
   47 breakOff, breakOn :: Int
   48 breakOn  = 0
   49 breakOff = -1
   50 
   51 showBreakArray :: BreakArray -> IO ()
   52 showBreakArray array = do
   53     forM_ [0 .. (size array - 1)] $ \i -> do
   54         val <- readBreakArray array i
   55         putStr $ ' ' : show val
   56     putStr "\n"
   57 
   58 setupBreakpoint :: BreakArray -> Int -> Int -> IO Bool
   59 setupBreakpoint breakArray ind val
   60     | safeIndex breakArray ind = do
   61         writeBreakArray breakArray ind val
   62         return True
   63     | otherwise = return False
   64 
   65 getBreak :: BreakArray -> Int -> IO (Maybe Int)
   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) = size `div` SIZEOF_HSWORD
   77   where
   78     -- We want to keep this operation pure. The mutable byte array
   79     -- is never resized so this is safe.
   80     size = unsafeDupablePerformIO $ sizeofMutableByteArray array
   81 
   82     sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int
   83     sizeofMutableByteArray arr =
   84         IO $ \s -> case getSizeofMutableByteArray# arr s of
   85                        (# s', n# #) -> (# s', I# n# #)
   86 
   87 allocBA :: Int# -> IO BreakArray
   88 allocBA sz# = IO $ \s1 ->
   89     case newByteArray# sz# s1 of { (# s2, array #) -> (# s2, BA array #) }
   90 
   91 -- create a new break array and initialise all elements to breakOff.
   92 newBreakArray :: Int -> IO BreakArray
   93 newBreakArray (I# sz#) = do
   94     BA array <- allocBA (sz# *# SIZEOF_HSWORD#)
   95     case breakOff of
   96         I# off -> do
   97            let loop n | isTrue# (n >=# sz#) = return ()
   98                       | otherwise = do writeBA# array n off; loop (n +# 1#)
   99            loop 0#
  100     return $ BA array
  101 
  102 writeBA# :: MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
  103 writeBA# array ind val = IO $ \s ->
  104     case writeIntArray# array ind val s of { s -> (# s, () #) }
  105 
  106 writeBreakArray :: BreakArray -> Int -> Int -> IO ()
  107 writeBreakArray (BA array) (I# i) (I# val) = writeBA# array i val
  108 
  109 readBA# :: MutableByteArray# RealWorld -> Int# -> IO Int
  110 readBA# array i = IO $ \s ->
  111     case readIntArray# array i s of { (# s, c #) -> (# s, I# c #) }
  112 
  113 readBreakArray :: BreakArray -> Int -> IO Int
  114 readBreakArray (BA array) (I# ind# ) = readBA# array ind#