X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FPretty.lhs;h=9c94c8eb0cc926a5bf89e56520c369dc2981ded1;hb=62f6cc1dec4223532fbd15de64db4fb036932944;hp=0fc817f288a79e260d63952c27b6861a2b0b1084;hpb=2d52ee06786e5caf0c2d65a4b4bb7c45c6493190;p=ghc-hetmet.git

diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs
index 0fc817f..9c94c8e 100644
--- a/compiler/utils/Pretty.lhs
+++ b/compiler/utils/Pretty.lhs
@@ -87,7 +87,7 @@ Relative to John's original paper, there are the following new features:
     It is Really Useful in practice.
 
 2.  There is a paragraph-fill combinator, fsep, that's much like sep,
-    only it keeps fitting things on one line until itc can't fit any more.
+    only it keeps fitting things on one line until it can't fit any more.
 
 3.  Some random useful extra combinators are provided.  
         <+> puts its arguments beside each other with a space between them,
@@ -152,6 +152,13 @@ Relative to John's original paper, there are the following new features:
 
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module Pretty (
         Doc,            -- Abstract
         Mode(..), TextDetails(..),
@@ -162,7 +169,7 @@ module Pretty (
         int, integer, float, double, rational,
         parens, brackets, braces, quotes, doubleQuotes,
         semi, comma, colon, space, equals,
-        lparen, rparen, lbrack, rbrack, lbrace, rbrace,
+        lparen, rparen, lbrack, rbrack, lbrace, rbrace, cparen,
 
         (<>), (<+>), hcat, hsep, 
         ($$), ($+$), vcat, 
@@ -446,7 +453,7 @@ int      n = text (show n)
 integer  n = text (show n)
 float    n = text (show n)
 double   n = text (show n)
-rational n = text (show (fromRat n))
+rational n = text (show (fromRat n :: Double))
 --rational n = text (show (fromRationalX n)) -- _showRational 30 n)
 
 quotes p        = char '`' <> p <> char '\''
@@ -455,6 +462,8 @@ parens p        = char '(' <> p <> char ')'
 brackets p      = char '[' <> p <> char ']'
 braces p        = char '{' <> p <> char '}'
 
+cparen True  = parens
+cparen False = id
 
 hcat = foldr (<>)  empty
 hsep = foldr (<+>) empty
@@ -980,26 +989,29 @@ display mode IBOX(page_width) IBOX(ribbon_width) txt end doc
 
                     other -> lay1 k s sl p
     
-        lay1 k s sl p = Str (indent k) `txt` (s `txt` lay2 (k PLUS sl) p)
+        lay1 k s sl p = indent k (s `txt` lay2 (k PLUS sl) p)
     
         lay2 k (NilAbove p)        = nl_text `txt` lay k p
         lay2 k (TextBeside s sl p) = s `txt` (lay2 (k PLUS sl) p)
         lay2 k (Nest _ p)          = lay2 k p
         lay2 k Empty               = end
+
+        -- optimise long indentations using LitString chunks of 8 spaces
+        indent n r | n GREQ ILIT(8) = LStr "        "# 8# `txt` 
+                                      indent (n MINUS ILIT(8)) r
+                   | otherwise      = Str (spaces n) `txt` r
     in
     lay ILIT(0) doc
     }}
 
 cant_fail = error "easy_display: NoDoc"
 
-indent n | n GREQ ILIT(8) = '\t' : indent (n MINUS ILIT(8))
-         | otherwise      = spaces n
-
 multi_ch n ch | n LTEQ ILIT(0) = ""
 	      | otherwise      = ch : multi_ch (n MINUS ILIT(1)) ch
 
 spaces n | n LTEQ ILIT(0) = ""
          | otherwise      = ' ' : spaces (n MINUS ILIT(1))
+
 \end{code}
 
 \begin{code}
@@ -1022,11 +1034,7 @@ printDoc mode hdl doc
   -- some versions of hPutBuf will barf if the length is zero
 hPutLitString handle a# 0# = return ()
 hPutLitString handle a# l#
-#if __GLASGOW_HASKELL__ < 411
-  = hPutBuf handle (A# a#) (I# l#)
-#else
   = hPutBuf handle (Ptr a#) (I# l#)
-#endif
 
 -- Printing output in LeftMode is performance critical: it's used when
 -- dumping C and assembly output, so we allow ourselves a few dirty
@@ -1066,9 +1074,4 @@ layLeft b (TextBeside s sl p) 	= put b s >> layLeft b p
     put b (Str s)    = bPutStr  b s
     put b (PStr s)   = bPutFS   b s
     put b (LStr s l) = bPutLitString b s l
-
-#if __GLASGOW_HASKELL__ < 503
-hPutBuf = hPutBufFull
-#endif
-
 \end{code}