X-Git-Url: http://git.megacz.com/?p=ghc-prim.git;a=blobdiff_plain;f=GHC%2FDebug.hs;fp=GHC%2FDebug.hs;h=30efc403a660c35aabe4aeab7ee7b9a1e09952e2;hp=0000000000000000000000000000000000000000;hb=a19a1b386c04d9a33348dedbd72f58798fdac10b;hpb=cc029cd1a6d3712f8f6ae2e936c26c8bc337f097

diff --git a/GHC/Debug.hs b/GHC/Debug.hs
new file mode 100644
index 0000000..30efc40
--- /dev/null
+++ b/GHC/Debug.hs
@@ -0,0 +1,31 @@
+
+module GHC.Debug (debugLn) where
+
+import GHC.Prim
+import GHC.Types
+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)
+    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'
+
+foreign import ccall unsafe "debugLn"
+    c_debugLn :: MutableByteArray# RealWorld -> IO ()
+