{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
module GHCi.BreakArray
(
BreakArray
(BA)
, newBreakArray
, getBreak
, setupBreakpoint
, breakOn
, breakOff
, showBreakArray
) where
import Prelude
import Control.Monad
import GHC.Exts
import GHC.IO ( IO(..) )
import System.IO.Unsafe ( unsafeDupablePerformIO )
#include "MachDeps.h"
data BreakArray = BA (MutableByteArray# RealWorld)
breakOff, breakOn :: Int
breakOn :: Int
breakOn = Int
0
breakOff :: Int
breakOff = -Int
1
showBreakArray :: BreakArray -> IO ()
showBreakArray :: BreakArray -> IO ()
showBreakArray BreakArray
array = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. (BreakArray -> Int
size BreakArray
array forall a. Num a => a -> a -> a
- Int
1)] forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Int
val <- BreakArray -> Int -> IO Int
readBreakArray BreakArray
array Int
i
String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ Char
' ' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
val
String -> IO ()
putStr String
"\n"
setupBreakpoint :: BreakArray -> Int -> Int -> IO Bool
setupBreakpoint :: BreakArray -> Int -> Int -> IO Bool
setupBreakpoint BreakArray
breakArray Int
ind Int
val
| BreakArray -> Int -> Bool
safeIndex BreakArray
breakArray Int
ind = do
BreakArray -> Int -> Int -> IO ()
writeBreakArray BreakArray
breakArray Int
ind Int
val
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
getBreak :: BreakArray -> Int -> IO (Maybe Int)
getBreak :: BreakArray -> Int -> IO (Maybe Int)
getBreak BreakArray
array Int
index
| BreakArray -> Int -> Bool
safeIndex BreakArray
array Int
index = do
Int
val <- BreakArray -> Int -> IO Int
readBreakArray BreakArray
array Int
index
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
val
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
safeIndex :: BreakArray -> Int -> Bool
safeIndex :: BreakArray -> Int -> Bool
safeIndex BreakArray
array Int
index = Int
index forall a. Ord a => a -> a -> Bool
< BreakArray -> Int
size BreakArray
array Bool -> Bool -> Bool
&& Int
index forall a. Ord a => a -> a -> Bool
>= Int
0
size :: BreakArray -> Int
size :: BreakArray -> Int
size (BA MutableByteArray# RealWorld
array) = Int
size forall a. Integral a => a -> a -> a
`div` SIZEOF_HSWORD
where
size :: Int
size = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld -> IO Int
sizeofMutableByteArray MutableByteArray# RealWorld
array
sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int
sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int
sizeofMutableByteArray MutableByteArray# RealWorld
arr =
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# RealWorld
arr State# RealWorld
s of
(# State# RealWorld
s', Int#
n# #) -> (# State# RealWorld
s', Int# -> Int
I# Int#
n# #)
allocBA :: Int# -> IO BreakArray
allocBA :: Int# -> IO BreakArray
allocBA Int#
sz# = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s1 ->
case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
sz# State# RealWorld
s1 of { (# State# RealWorld
s2, MutableByteArray# RealWorld
array #) -> (# State# RealWorld
s2, MutableByteArray# RealWorld -> BreakArray
BA MutableByteArray# RealWorld
array #) }
newBreakArray :: Int -> IO BreakArray
newBreakArray :: Int -> IO BreakArray
newBreakArray (I# Int#
sz#) = do
BA MutableByteArray# RealWorld
array <- Int# -> IO BreakArray
allocBA (Int#
sz# Int# -> Int# -> Int#
*# SIZEOF_HSWORD#)
case Int
breakOff of
I# Int#
off -> do
let loop :: Int# -> IO ()
loop Int#
n | Int# -> Bool
isTrue# (Int#
n Int# -> Int# -> Int#
>=# Int#
sz#) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
n Int#
off; Int# -> IO ()
loop (Int#
n Int# -> Int# -> Int#
+# Int#
1#)
Int# -> IO ()
loop Int#
0#
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld -> BreakArray
BA MutableByteArray# RealWorld
array
writeBA# :: MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
writeBA# :: MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
ind Int#
val = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# RealWorld
array Int#
ind Int#
val State# RealWorld
s of { State# RealWorld
s -> (# State# RealWorld
s, () #) }
writeBreakArray :: BreakArray -> Int -> Int -> IO ()
writeBreakArray :: BreakArray -> Int -> Int -> IO ()
writeBreakArray (BA MutableByteArray# RealWorld
array) (I# Int#
i) (I# Int#
val) = MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
i Int#
val
readBA# :: MutableByteArray# RealWorld -> Int# -> IO Int
readBA# :: MutableByteArray# RealWorld -> Int# -> IO Int
readBA# MutableByteArray# RealWorld
array Int#
i = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readIntArray# MutableByteArray# RealWorld
array Int#
i State# RealWorld
s of { (# State# RealWorld
s, Int#
c #) -> (# State# RealWorld
s, Int# -> Int
I# Int#
c #) }
readBreakArray :: BreakArray -> Int -> IO Int
readBreakArray :: BreakArray -> Int -> IO Int
readBreakArray (BA MutableByteArray# RealWorld
array) (I# Int#
ind# ) = MutableByteArray# RealWorld -> Int# -> IO Int
readBA# MutableByteArray# RealWorld
array Int#
ind#