From: Ian Lynagh <igloo@earth.li>
Date: Fri, 10 Jul 2009 00:36:35 +0000 (+0000)
Subject: Add a debugErrLn function, which is like debugLn except it prints to stderr
X-Git-Tag: Haskell_2010_report_generated~5
X-Git-Url: http://git.megacz.com/?p=ghc-prim.git;a=commitdiff_plain;h=57a1e3e7929fab71df05483f3165764e488cdcf9

Add a debugErrLn function, which is like debugLn except it prints to stderr
---

diff --git a/GHC/Debug.hs b/GHC/Debug.hs
index 595f808..553cf72 100644
--- a/GHC/Debug.hs
+++ b/GHC/Debug.hs
@@ -1,5 +1,5 @@
 
-module GHC.Debug (debugLn) where
+module GHC.Debug (debugLn, debugErrLn) where
 
 import GHC.Prim
 import GHC.Types
@@ -7,16 +7,34 @@ import GHC.Unit ()
 
 debugLn :: [Char] -> IO ()
 debugLn xs = IO (\s0 ->
-                 -- 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 ->
-                             case c_debugLn mba of
-                             IO f -> f s2)
+                 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'
 
@@ -26,6 +44,3 @@ debugLn xs = IO (\s0 ->
                 s' ->
                     write mba (offset +# 1#) xs' s'
 
-foreign import ccall unsafe "debugLn"
-    c_debugLn :: MutableByteArray# RealWorld -> IO ()
-
diff --git a/cbits/debug.c b/cbits/debug.c
index ff34c5a..3a57098 100644
--- a/cbits/debug.c
+++ b/cbits/debug.c
@@ -4,3 +4,7 @@
 void debugLn(char *s) {
     printf("%s\n", s);
 }
+
+void debugErrLn(char *s) {
+    fprintf(stderr, "%s\n", s);
+}