summaryrefslogtreecommitdiff
path: root/libraries/ghc-prim/GHC/Debug.hs
blob: ac8a0f5d7903fc1c0be70b792a68d336d8120c97 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
{-# 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 xs = IO (\s0 ->
                 case mkMBA s0 xs of
                 (# s1, mba #) ->
                     case c_debugLn mba of
                     IO f -> f s1)

debugErrLn :: [Char] -> IO ()
debugErrLn xs = IO (\s0 ->
                    case mkMBA s0 xs of
                    (# s1, mba #) ->
                        case c_debugErrLn mba of
                        IO f -> f 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 s0 xs = -- Start with 1 so that we have space to put in a \0 at
              -- the end
              case len 1# xs of
              l ->
                  case newByteArray# l s0 of
                  (# s1, mba #) ->
                      case write mba 0# xs s1 of
                      s2 -> (# s2, mba #)
    where len l [] = l
          len l (_ : xs') = len (l +# 1#) xs'

          write mba offset [] s = writeCharArray# mba offset '\0'# s
          write mba offset (C# x : xs') s
              = case writeCharArray# mba offset x s of
                s' ->
                    write mba (offset +# 1#) xs' s'