Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Attempt to repair the "text/str" RULE

Idea is to automatically skip the conversion to String where possible -
Pretty can work with the original C-Strings just as well. There is a
rule for that already, but it doesn't fire due to string fusion getting
in the way.

This is an attempt to restore the original behaviour. Unluckily, it comes
with worse performance in corner cases, see comments.
  • Loading branch information...
commit 9afbda2015252c60c14bb9a846bb9889a7dc2459 1 parent 8041d66
Peter Wortmann authored
Showing with 36 additions and 2 deletions.
  1. +2 −0  compiler/utils/Outputable.lhs
  2. +34 −2 compiler/utils/Pretty.lhs
2  compiler/utils/Outputable.lhs
View
@@ -444,6 +444,8 @@ float n = docToSDoc $ Pretty.float n
double n = docToSDoc $ Pretty.double n
rational n = docToSDoc $ Pretty.rational n
+{-# INLINE text #-}
+
parens, braces, brackets, quotes, quote, doubleQuotes, angleBrackets :: SDoc -> SDoc
parens d = SDoc $ Pretty.parens . runSDoc d
36 compiler/utils/Pretty.lhs
View
@@ -191,8 +191,8 @@ import System.IO
#if defined(__GLASGOW_HASKELL__)
--for a RULES
-import GHC.Base ( unpackCString# )
-import GHC.Exts ( Int# )
+import GHC.Base ( unpackCString#, unpackFoldrCString# )
+import GHC.Exts ( Int#, build )
import GHC.Ptr ( Ptr(..) )
#endif
@@ -571,6 +571,38 @@ zeroWidthText s = textBeside_ (Str s) (_ILIT(0)) Empty
{-# RULES
"text/str" forall a. text (unpackCString# a) = ptext (Ptr a)
#-}
+
+-- RULES that *actually* do it. The problem here is that string fusion
+-- will turn the string into something like
+--
+-- build (unpackFoldrCString# "...")
+--
+-- the first chance it gets (which is earlier than the above rule
+-- matches, from the looks of it). This eventually gets turned back
+-- into the original string, but again too late for the rule to
+-- fire.
+--
+-- So the following rules try to transform the expression back from
+-- its string-fusion form. Unluckily, this leaves the possibility that
+-- we get a very inefficient representation using "appendChar" and
+-- "empty" if the foldr representation of text *actually* gets fused
+-- at some point.
+--
+-- For example:
+-- text (map toUpper "...")
+-- -> unpackFoldrCString# "..." (appendChar . toUpper) Pretty.Empty
+
+{-# RULES
+ "text" [~1] text = foldr appendChar empty;
+ "textInv" [1] foldr appendChar empty = text;
+ "pprStr" forall a. unpackFoldrCString# a appendChar Pretty.Empty = ptext (Ptr a);
+ #-}
+{-# NOINLINE [1] text #-}
+
+appendChar :: Char -> Doc -> Doc
+appendChar c d = char c <> d
+{-# NOINLINE [1] appendChar #-}
+
#endif
nest k p = mkNest (iUnbox k) (reduceDoc p) -- Externally callable version
Please sign in to comment.
Something went wrong with that request. Please try again.