Make some profiling flags dynamic

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

diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs
index bebb6b2..7aec715 100644 (file)
--- a/compiler/utils/Pretty.lhs
+++ b/compiler/utils/Pretty.lhs
@@ -1,15 +1,15 @@
-*********************************************************************************
-*                                                                               *
-*       John Hughes's and Simon Peyton Jones's Pretty Printer Combinators       *
-*                                                                               *
-*               based on "The Design of a Pretty-printing Library"              *
-*               in Advanced Functional Programming,                             *
-*               Johan Jeuring and Erik Meijer (eds), LNCS 925                   *
-*               http://www.cs.chalmers.se/~rjmh/Papers/pretty.ps                *
-*                                                                               *
-*               Heavily modified by Simon Peyton Jones, Dec 96                  *
-*                                                                               *
-*********************************************************************************
+%*********************************************************************************
+%*                                                                               *
+%*       John Hughes's and Simon Peyton Jones's Pretty Printer Combinators       *
+%*                                                                               *
+%*               based on "The Design of a Pretty-printing Library"              *
+%*               in Advanced Functional Programming,                             *
+%*               Johan Jeuring and Erik Meijer (eds), LNCS 925                   *
+%*               http://www.cs.chalmers.se/~rjmh/Papers/pretty.ps                *
+%*                                                                               *
+%*               Heavily modified by Simon Peyton Jones, Dec 96                  *
+%*                                                                               *
+%*********************************************************************************
 
 Version 3.0     28 May 1997
   * Cured massive performance bug.  If you write
@@ -152,13 +152,17 @@ Relative to John's original paper, there are the following new features:
 
 
 \begin{code}
+{-# OPTIONS -fno-warn-unused-imports #-}
+-- XXX GHC 6.9 seems to be confused by unpackCString# being used only in
+--     a RULE
+
 module Pretty (
         Doc,            -- Abstract
         Mode(..), TextDetails(..),
 
         empty, isEmpty, nest,
 
-        text, char, ftext, ptext,
+        char, text, ftext, ptext,
         int, integer, float, double, rational,
         parens, brackets, braces, quotes, doubleQuotes,
         semi, comma, colon, space, equals,
@@ -175,8 +179,6 @@ module Pretty (
         render, fullRender, printDoc, showDocWith
   ) where
 
-#include "HsVersions.h"
-
 import BufWrite
 import FastString
 import FastTypes
@@ -209,11 +211,11 @@ infixl 5 $$, $+$
 \end{code}
 
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{The interface}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 The primitive @Doc@ values
 
@@ -296,11 +298,11 @@ data Mode = PageMode            -- Normal
 \end{code}
 
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{The @Doc@ calculus}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 The @Doc@ combinators satisfy the following laws:
 \begin{verbatim}
@@ -334,8 +336,8 @@ Laws for nest
 <n5>    nest k empty            = empty
 <n6>    x <> nest k y           = x <> y, if x non-empty
 
-** Note the side condition on <n6>!  It is this that
-** makes it OK for empty to be a left unit for <>.
+ - Note the side condition on <n6>!  It is this that
+   makes it OK for empty to be a left unit for <>.
 
 Miscellaneous
 ~~~~~~~~~~~~~
@@ -375,11 +377,11 @@ But it doesn't work, for if x=empty, we would have
 
 
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{Simple derived definitions}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 \begin{code}
 semi  = char ';'
@@ -425,11 +427,11 @@ punctuate p (d:ds) = go d ds
 \end{code}
 
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{The @Doc@ data type}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 A @Doc@ represents a {\em set} of layouts.  A @Doc@ with
 no occurrences of @Union@ or @NoDoc@ represents just one layout.
@@ -529,7 +531,6 @@ union_ p q = Union (LOCAL_ASSERT( _ok p ) p) (LOCAL_ASSERT( _ok q ) q)
              _ok _                  = False
 \end{code}
 
-
 Notice the difference between
         * NoDoc (no documents)
         * Empty (one empty document; no height and no width)
@@ -538,11 +539,11 @@ Notice the difference between
 
 
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{@empty@, @text@, @nest@, @union@}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 \begin{code}
 empty = Empty
@@ -555,7 +556,7 @@ text  s = case iUnbox (length   s) of {sl -> textBeside_ (Str s)  sl Empty}
 ftext :: FastString -> Doc
 ftext s = case iUnbox (lengthFS s) of {sl -> textBeside_ (PStr s) sl Empty}
 ptext :: LitString -> Doc
-ptext s_= case iUnbox (strLength s) of {sl -> textBeside_ (LStr s sl) sl Empty}
+ptext s_= case iUnbox (lengthLS s) of {sl -> textBeside_ (LStr s sl) sl Empty}
   where s = {-castPtr-} s_
 
 #if defined(__GLASGOW_HASKELL__)
@@ -582,11 +583,11 @@ mkUnion Empty _ = Empty
 mkUnion p q     = p `union_` q
 \end{code}
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{Vertical composition @$$@}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 
 \begin{code}
@@ -635,11 +636,11 @@ nilAboveNest g k q           | (not g) && (k ># _ILIT(0))        -- No newline i
 \end{code}
 
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{Horizontal composition @<>@}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 \begin{code}
 p <>  q = Beside p False q
@@ -677,11 +678,11 @@ nilBeside g p          | g         = textBeside_ space_text (_ILIT(1)) p
                        | otherwise = p
 \end{code}
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{Separate, @sep@, Hughes version}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 \begin{code}
 -- Specification: sep ps  = oneLiner (hsep ps)
@@ -730,11 +731,11 @@ sepNB g Empty k ys        = oneLiner (nilBeside g (reduceDoc rest))
 sepNB g p k ys            = sep1 g p k ys
 \end{code}
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{@fill@}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 \begin{code}
 fsep = fill True
@@ -780,11 +781,11 @@ fillNB g p k ys            = fill1 g p k ys
 \end{code}
 
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{Selecting the best layout}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 \begin{code}
 best :: Int             -- Line length
@@ -871,11 +872,11 @@ oneLiner _                   = panic "oneLiner: Unhandled case"
 
 
 
-*********************************************************
-*                                                       *
+%*********************************************************
+%*                                                       *
 \subsection{Displaying the best layout}
-*                                                       *
-*********************************************************
+%*                                                       *
+%*********************************************************
 
 
 \begin{code}
@@ -974,7 +975,7 @@ display mode page_width ribbon_width txt end doc
         lay2 _ _                   = panic "display/lay2: Unhandled case"
 
         -- optimise long indentations using LitString chunks of 8 spaces
-        indent n r | n >=# _ILIT(8) = LStr SLIT("        ") (_ILIT(8)) `txt`
+        indent n r | n >=# _ILIT(8) = LStr (sLit "        ") (_ILIT(8)) `txt`
                                       indent (n -# _ILIT(8)) r
                    | otherwise      = Str (spaces n) `txt` r
     in
@@ -996,8 +997,12 @@ spaces n | n <=# _ILIT(0) = ""
 
 \begin{code}
 pprCols :: Int
-pprCols = 120 -- could make configurable
+pprCols = 100 -- could make configurable
 
+-- NB. printDoc prints FastStrings in UTF-8: hPutFS below does no decoding.
+-- This is what we usually want, because the IO library has no encoding
+-- functionality, and we're assuming UTF-8 source code so we might as well
+-- assume UTF-8 output too.
 printDoc :: Mode -> Handle -> Doc -> IO ()
 printDoc LeftMode hdl doc
   = do { printLeftRender hdl doc; hFlush hdl }