X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FPretty.lhs;h=ab9864b68ba994810cb3a42228606f05c9e65226;hb=6e5df3a4551b8d8b83e936b3f7b52edfc778ca8a;hp=994435a2dcc85185f672b38e791b10fae4c1a776;hpb=8c4bd8988ae062f8b6084b99277250eae362dbbf;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/Pretty.lhs b/ghc/compiler/utils/Pretty.lhs
index 994435a..ab9864b 100644
--- a/ghc/compiler/utils/Pretty.lhs
+++ b/ghc/compiler/utils/Pretty.lhs
@@ -178,9 +178,11 @@ module Pretty (
 #include "HsVersions.h"
 
 import FastString
-import GlaExts
-import Numeric (fromRat)
 import PrimPacked 	( strLength )
+
+import GLAEXTS
+
+import Numeric (fromRat)
 import IO
 
 #if __GLASGOW_HASKELL__ < 503
@@ -195,14 +197,7 @@ import PrelBase		( unpackCString# )
 import GHC.Base		( unpackCString# )
 #endif
 
-import PrimPacked 	( strLength )
-
-#if __GLASGOW_HASKELL__ < 411
-import PrelAddr		( Addr(..) )
-#else
-import Addr		( Addr(..) )
-import Ptr		( Ptr(..) )
-#endif
+import PrimPacked	( Ptr(..) )
 
 -- Don't import Util( assertPanic ) because it makes a loop in the module structure
 
@@ -606,12 +601,12 @@ isEmpty _     = False
 char  c = textBeside_ (Chr c) 1# Empty
 text  s = case length   s of {IBOX(sl) -> textBeside_ (Str 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}
+ptext (Ptr s) = case strLength (Ptr s) of {IBOX(sl) -> textBeside_ (LStr s sl) sl Empty}
 
 -- RULE that turns (text "abc") into (ptext (A# "abc"#)) to avoid the
 -- intermediate packing/unpacking of the string.
 {-# RULES 
-  "text/str" forall a. text (unpackCString# a) = ptext (A# a)
+  "text/str" forall a. text (unpackCString# a) = ptext (Ptr a)
  #-}
 
 nest IBOX(k)  p = mkNest k (reduceDoc p)        -- Externally callable version
@@ -1022,7 +1017,8 @@ pprCols = (100 :: Int) -- could make configurable
 
 printDoc :: Mode -> Handle -> Doc -> IO ()
 printDoc mode hdl doc
-  = fullRender mode pprCols 1.5 put done doc
+  = do { fullRender mode pprCols 1.5 put done doc ;
+	 hFlush hdl }
   where
     put (Chr c)  next = hPutChar hdl c >> next 
     put (Str s)  next = hPutStr  hdl s >> next 
@@ -1035,6 +1031,8 @@ printDoc mode hdl doc
 hPutBuf = hPutBufFull
 #endif
 
+  -- 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#)