[project @ 2001-12-06 10:45:42 by simonpj]

[ghc-hetmet.git] / ghc / compiler / utils / Pretty.lhs

diff --git a/ghc/compiler/utils/Pretty.lhs b/ghc/compiler/utils/Pretty.lhs
index 6e24448..c033683 100644 (file)
--- a/ghc/compiler/utils/Pretty.lhs
+++ b/ghc/compiler/utils/Pretty.lhs
@@ -172,7 +172,7 @@ module Pretty (
         hang, punctuate,
         
 --      renderStyle,            -- Haskell 1.3 only
-        render, fullRender
+        render, fullRender, printDoc
   ) where
 
 #include "HsVersions.h"
@@ -180,6 +180,7 @@ module Pretty (
 import FastString
 import GlaExts
 import Numeric (fromRat)
+import IO
 
 -- Don't import Util( assertPanic ) because it makes a loop in the module structure
 
@@ -204,12 +205,13 @@ allow you to use either GHC or Hugs.  To get GHC, just set the CPP variable
 
 #if defined(__GLASGOW_HASKELL__)
 
-
 -- Glasgow Haskell
 
 -- Disable ASSERT checks; they are expensive!
 #define LOCAL_ASSERT(x)
 
+#define ILIT(x) (x#)
+#define IBOX(x) (I# (x))
 #define INT     Int#
 #define MINUS   -#
 #define NEGATE  negateInt#
@@ -967,3 +969,17 @@ multi_ch n       ch = ch : multi_ch (n MINUS ILIT(1)) ch
 spaces ILIT(0) = ""
 spaces n       = ' ' : spaces (n MINUS ILIT(1))
 \end{code}
+
+\begin{code}
+pprCols = (100 :: Int) -- could make configurable
+
+printDoc :: Mode -> Handle -> Doc -> IO ()
+printDoc mode hdl doc
+  = fullRender mode pprCols 1.5 put done doc
+  where
+    put (Chr c)  next = hPutChar hdl c >> next 
+    put (Str s)  next = hPutStr  hdl s >> next 
+    put (PStr s) next = hPutFS   hdl s >> next 
+
+    done = hPutChar hdl '\n'
+\end{code}