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 ()),
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,
hang, punctuate,
-- renderStyle, -- Haskell 1.3 only
- render, fullRender, printDoc
+ render, fullRender, printDoc, showDocWith
) where
#include "HsVersions.h"
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 <>
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}
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
= 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}
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}