[commit: ghc] master: Make sure that Pretty.text is inlined in stage 0, so that RULE text/str gets a chance to fire (Trac #7995). (d2c3630)

[Simon Peyton Jones]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/d2c3630dedc577f7e6eb8e945b05a86992bd5e0a

>---------------------------------------------------------------

commit d2c3630dedc577f7e6eb8e945b05a86992bd5e0a
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Jun 21 17:41:26 2013 +0100

    Make sure that Pretty.text is inlined in stage 0,
    so that RULE text/str gets a chance to fire (Trac #7995).
    
    And make sure that Outputable.text is inlined, so that the underlying
    Pretty.text rule can fire.
    
    The thing is that literal strings only turn into unpackCString#
    in phase 1.

>---------------------------------------------------------------

 compiler/utils/Outputable.lhs | 3 +++
 compiler/utils/Pretty.lhs     | 4 +++-
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index bd2a955..88a8a75 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -421,7 +421,10 @@ rational :: Rational   -> SDoc
 
 empty       = docToSDoc $ Pretty.empty
 char c      = docToSDoc $ Pretty.char c
+
 text s      = docToSDoc $ Pretty.text s
+{-# INLINE text #-}   -- Inline so that the RULE Pretty.text will fire
+
 ftext s     = docToSDoc $ Pretty.ftext s
 ptext s     = docToSDoc $ Pretty.ptext s
 ztext s     = docToSDoc $ Pretty.ztext s
diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs
index e4f748a..0c8e5fa 100644
--- a/compiler/utils/Pretty.lhs
+++ b/compiler/utils/Pretty.lhs
@@ -557,7 +557,9 @@ isEmpty _     = False
 char  c = textBeside_ (Chr c) (_ILIT(1)) Empty
 
 text  s = case iUnbox (length   s) of {sl -> textBeside_ (Str s)  sl Empty}
-{-# NOINLINE [1] text #-}   -- Give the RULE a chance to fire
+{-# NOINLINE [0] text #-}   -- Give the RULE a chance to fire
+                            -- It must wait till after phase 1 when
+                            -- the unpackCString first is manifested
 
 ftext :: FastString -> Doc
 ftext s = case iUnbox (lengthFS s) of {sl -> textBeside_ (PStr s) sl Empty}