summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2013-06-21 17:41:26 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2013-06-24 13:10:47 +0100
commitd2c3630dedc577f7e6eb8e945b05a86992bd5e0a (patch)
tree2666a329e1a7a67a3188aaf3253927e55f802d7b
parent59d6942f6399de9cdb444e84f721078881c1deee (diff)
downloadhaskell-d2c3630dedc577f7e6eb8e945b05a86992bd5e0a.tar.gz
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.
-rw-r--r--compiler/utils/Outputable.lhs3
-rw-r--r--compiler/utils/Pretty.lhs4
2 files changed, 6 insertions, 1 deletions
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index bd2a955469..88a8a75c62 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 e4f748a05d..0c8e5fa1d0 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}