{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples, UnliftedFFITypes #-}
module GHC.Debug ( debugLn, debugErrLn ) where
import GHC.Prim
import GHC.Types
import GHC.Tuple ()
debugLn :: [Char] -> IO ()
debugLn :: [Char] -> IO ()
debugLn [Char]
xs = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s0 ->
case State# RealWorld
-> [Char] -> (# State# RealWorld, MutableByteArray# RealWorld #)
mkMBA State# RealWorld
s0 [Char]
xs of
(# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) ->
case MutableByteArray# RealWorld -> IO ()
c_debugLn MutableByteArray# RealWorld
mba of
IO State# RealWorld -> (# State# RealWorld, () #)
f -> State# RealWorld -> (# State# RealWorld, () #)
f State# RealWorld
s1)
debugErrLn :: [Char] -> IO ()
debugErrLn :: [Char] -> IO ()
debugErrLn [Char]
xs = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s0 ->
case State# RealWorld
-> [Char] -> (# State# RealWorld, MutableByteArray# RealWorld #)
mkMBA State# RealWorld
s0 [Char]
xs of
(# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) ->
case MutableByteArray# RealWorld -> IO ()
c_debugErrLn MutableByteArray# RealWorld
mba of
IO State# RealWorld -> (# State# RealWorld, () #)
f -> State# RealWorld -> (# State# RealWorld, () #)
f State# RealWorld
s1)
foreign import ccall unsafe "debugLn"
c_debugLn :: MutableByteArray# RealWorld -> IO ()
foreign import ccall unsafe "debugErrLn"
c_debugErrLn :: MutableByteArray# RealWorld -> IO ()
mkMBA :: State# RealWorld -> [Char] ->
(# State# RealWorld, MutableByteArray# RealWorld #)
mkMBA :: State# RealWorld
-> [Char] -> (# State# RealWorld, MutableByteArray# RealWorld #)
mkMBA State# RealWorld
s0 [Char]
xs =
case Int# -> [Char] -> Int#
forall {a}. Int# -> [a] -> Int#
len Int#
1# [Char]
xs of
Int#
l ->
case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
l State# RealWorld
s0 of
(# State# RealWorld
s1, MutableByteArray# RealWorld
mba #) ->
case MutableByteArray# RealWorld
-> Int# -> [Char] -> State# RealWorld -> State# RealWorld
forall {d}.
MutableByteArray# d -> Int# -> [Char] -> State# d -> State# d
write MutableByteArray# RealWorld
mba Int#
0# [Char]
xs State# RealWorld
s1 of
State# RealWorld
s2 -> (# State# RealWorld
s2, MutableByteArray# RealWorld
mba #)
where len :: Int# -> [a] -> Int#
len Int#
l [] = Int#
l
len Int#
l (a
_ : [a]
xs') = Int# -> [a] -> Int#
len (Int#
l Int# -> Int# -> Int#
+# Int#
1#) [a]
xs'
write :: MutableByteArray# d -> Int# -> [Char] -> State# d -> State# d
write MutableByteArray# d
mba Int#
offset [] State# d
s = MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeCharArray# MutableByteArray# d
mba Int#
offset Char#
'\0'# State# d
s
write MutableByteArray# d
mba Int#
offset (C# Char#
x : [Char]
xs') State# d
s
= case MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeCharArray# MutableByteArray# d
mba Int#
offset Char#
x State# d
s of
State# d
s' ->
MutableByteArray# d -> Int# -> [Char] -> State# d -> State# d
write MutableByteArray# d
mba (Int#
offset Int# -> Int# -> Int#
+# Int#
1#) [Char]
xs' State# d
s'