GHC/Debug.hs

   1
   2 module GHC.Debug (debugLn, debugErrLn) where
   3
   4 import GHC.Prim
   5 import GHC.Types
   6 import GHC.Unit ()
   7
   8 debugLn :: [Char] -> IO ()
   9 debugLn xs = IO (\s0 ->
  10                  case mkMBA s0 xs of
  11                  (# s1, mba #) ->
  12                      case c_debugLn mba of
  13                      IO f -> f s1)
  14
  15 debugErrLn :: [Char] -> IO ()
  16 debugErrLn xs = IO (\s0 ->
  17                     case mkMBA s0 xs of
  18                     (# s1, mba #) ->
  19                         case c_debugErrLn mba of
  20                         IO f -> f s1)
  21
  22 foreign import ccall unsafe "debugLn"
  23     c_debugLn :: MutableByteArray# RealWorld -> IO ()
  24
  25 foreign import ccall unsafe "debugErrLn"
  26     c_debugErrLn :: MutableByteArray# RealWorld -> IO ()
  27
  28 mkMBA :: State# RealWorld -> [Char] ->
  29          (# State# RealWorld, MutableByteArray# RealWorld #)
  30 mkMBA s0 xs = -- Start with 1 so that we have space to put in a \0 at
  31               -- the end
  32               case len 1# xs of
  33               l ->
  34                   case newByteArray# l s0 of
  35                   (# s1, mba #) ->
  36                       case write mba 0# xs s1 of
  37                       s2 -> (# s2, mba #)
  38     where len l [] = l
  39           len l (_ : xs') = len (l +# 1#) xs'
  40
  41           write mba offset [] s = writeCharArray# mba offset '\0'# s
  42           write mba offset (C# x : xs') s
  43               = case writeCharArray# mba offset x s of
  44                 s' ->
  45                     write mba (offset +# 1#) xs' s'
  46