[project @ 2002-04-29 14:03:38 by simonmar]

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

diff --git a/ghc/compiler/utils/Pretty.lhs b/ghc/compiler/utils/Pretty.lhs
index 08b3671..6f4f614 100644 (file)
--- a/ghc/compiler/utils/Pretty.lhs
+++ b/ghc/compiler/utils/Pretty.lhs
@@ -55,10 +55,10 @@ Version 3.0     28 May 1997
     The "fragments" are encapsulated in the TextDetails data type:
         data TextDetails = Chr  Char
                          | Str  String
-                         | PStr FAST_STRING
+                         | PStr FastString
 
     The Chr and Str constructors are obvious enough.  The PStr constructor has a packed
-    string (FAST_STRING) inside it.  It's generated by using the new "ptext" export.
+    string (FastString) inside it.  It's generated by using the new "ptext" export.
 
     An advantage of this new setup is that you can get the renderer to do output
     directly (by passing in a function of type (TextDetails -> IO () -> IO ()),
@@ -158,7 +158,7 @@ module Pretty (
 
         empty, isEmpty, nest,
 
-        text, char, ptext,
+        text, char, ftext, ptext,
         int, integer, float, double, rational,
         parens, brackets, braces, quotes, doubleQuotes,
         semi, comma, colon, space, equals,
@@ -172,7 +172,7 @@ module Pretty (
         hang, punctuate,
         
 --      renderStyle,            -- Haskell 1.3 only
-        render, fullRender, printDoc
+        render, fullRender, printDoc, showDocWith
   ) where
 
 #include "HsVersions.h"
@@ -180,8 +180,17 @@ module Pretty (
 import FastString
 import GlaExts
 import Numeric (fromRat)
+import PrimPacked      ( strLength )
 import IO
 
+#if __GLASGOW_HASKELL__ < 503
+import IOExts          ( hPutBufFull )
+#else
+import System.IO       ( hPutBuf )
+#endif
+
+import PrimPacked      ( strLength )
+
 -- Don't import Util( assertPanic ) because it makes a loop in the module structure
 
 infixl 6 <> 
@@ -493,7 +502,9 @@ reduceDoc p              = p
 
 data TextDetails = Chr  Char
                  | Str  String
-                 | PStr FAST_STRING
+                 | PStr FastString     -- a hashed string
+                | LStr Addr# Int#      -- a '\0'-terminated array of bytes
+
 space_text = Chr ' '
 nl_text    = Chr '\n'
 \end{code}
@@ -581,7 +592,8 @@ isEmpty _     = False
 
 char  c = textBeside_ (Chr c) 1# Empty
 text  s = case length   s of {IBOX(sl) -> textBeside_ (Str s)  sl Empty}
-ptext s = case _LENGTH_ s of {IBOX(sl) -> textBeside_ (PStr s) sl Empty}
+ftext s = case lengthFS s of {IBOX(sl) -> textBeside_ (PStr s) sl Empty}
+ptext (A# s) = case strLength (A# s) of {IBOX(sl) -> textBeside_ (LStr s sl) sl Empty}
 
 nest IBOX(k)  p = mkNest k (reduceDoc p)        -- Externally callable version
 
@@ -884,12 +896,28 @@ renderStyle Style{mode, lineLength, ribbonsPerLine} doc
   = fullRender mode lineLength ribbonsPerLine doc ""
 -}
 
-render doc       = showDoc doc ""
-showDoc doc rest = fullRender PageMode 100 1.5 string_txt rest doc
+render doc       = showDocWith PageMode doc
+showDoc doc rest = showDocWithAppend PageMode doc rest
+
+showDocWithAppend :: Mode -> Doc -> String -> String
+showDocWithAppend mode doc rest = fullRender mode 100 1.5 string_txt rest doc
+
+showDocWith :: Mode -> Doc -> String
+showDocWith mode doc = showDocWithAppend mode doc ""
 
 string_txt (Chr c)   s  = c:s
 string_txt (Str s1)  s2 = s1 ++ s2
-string_txt (PStr s1) s2 = _UNPK_ s1 ++ s2
+string_txt (PStr s1) s2 = unpackFS s1 ++ s2
+string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2
+
+unpackLitString addr =
+ unpack 0#
+ where
+    unpack nh
+      | ch `eqChar#` '\0'# = []
+      | otherwise   = C# ch : unpack (nh +# 1#)
+      where
+       ch = indexCharOffAddr# addr nh
 \end{code}
 
 \begin{code}
@@ -980,6 +1008,18 @@ printDoc mode hdl doc
     put (Chr c)  next = hPutChar hdl c >> next 
     put (Str s)  next = hPutStr  hdl s >> next 
     put (PStr s) next = hPutFS   hdl s >> next 
+    put (LStr s l) next = hPutLitString hdl s l >> next 
 
     done = hPutChar hdl '\n'
+
+#if __GLASGOW_HASKELL__ < 503
+hPutBuf = hPutBufFull
+#endif
+
+hPutLitString handle a# l#
+#if __GLASGOW_HASKELL__ < 411
+  = hPutBuf handle (A# a#) (I# l#)
+#else
+  = hPutBuf handle (Ptr a#) (I# l#)
+#endif
 \end{code}