Add a GHC.Debug module, with debugLn :: [Char] -> IO ()

3 files changed, 39 insertions, 0 deletions

diff --git a/libraries/ghc-prim/GHC/Debug.hs b/libraries/ghc-prim/GHC/Debug.hs
new file mode 100644
index 0000000000..30efc403a6
--- /dev/null
+++ b/libraries/ghc-prim/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 ()
+
diff --git a/libraries/ghc-prim/cbits/debug.c b/libraries/ghc-prim/cbits/debug.c
new file mode 100644
index 0000000000..ff34c5a90d
--- /dev/null
+++ b/libraries/ghc-prim/cbits/debug.c
@@ -0,0 +1,6 @@
+
+#include <stdio.h>
+
+void debugLn(char *s) {
+    printf("%s\n", s);
+}
diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal
index de9fd20be6..4300ad8cbe 100644
--- a/libraries/ghc-prim/ghc-prim.cabal
+++ b/libraries/ghc-prim/ghc-prim.cabal
@@ -23,6 +23,7 @@ Library {
     build-depends: rts
     exposed-modules:
         GHC.Bool
+        GHC.Debug
         GHC.Generics
         GHC.Ordering
         GHC.PrimopWrappers
@@ -37,6 +38,7 @@ Library {
     }
 
     c-sources:
+        cbits/debug.c
         cbits/longlong.c
     extensions: CPP, MagicHash, ForeignFunctionInterface, UnliftedFFITypes,
                 UnboxedTuples, EmptyDataDecls, NoImplicitPrelude