[commit: ghc] wip/pretty: Special-case reduce for horiz/vert (8e62060)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/pretty
Link       : http://ghc.haskell.org/trac/ghc/changeset/8e62060a28f041b267a004967ad8efa3cb465500/ghc

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

commit 8e62060a28f041b267a004967ad8efa3cb465500
Author: Eyal Lotem <eyal.lotem at gmail.com>
Date:   Tue Jul 2 02:36:31 2013 +0300

    Special-case reduce for horiz/vert
    
    This is a backport of c57c7a9dfc49617ba8d6e4fcdb019a3f29f1044c from
    libraries/pretty.


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

8e62060a28f041b267a004967ad8efa3cb465500
 compiler/utils/Pretty.hs | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs
index 49be9ee..ba717f3 100644
--- a/compiler/utils/Pretty.hs
+++ b/compiler/utils/Pretty.hs
@@ -529,15 +529,15 @@ reduceDoc p              = p
 
 -- | List version of '<>'.
 hcat :: [Doc] -> Doc
-hcat = reduceAB . foldr (\p q -> Beside p False q) empty
+hcat = snd . reduceHoriz . foldr (\p q -> Beside p False q) empty
 
 -- | List version of '<+>'.
 hsep :: [Doc] -> Doc
-hsep = reduceAB . foldr (\p q -> Beside p True q)  empty
+hsep = snd . reduceHoriz . foldr (\p q -> Beside p True q)  empty
 
 -- | List version of '$$'.
 vcat :: [Doc] -> Doc
-vcat = reduceAB . foldr (\p q -> Above p False q) empty
+vcat = snd . reduceVert . foldr (\p q -> Above p False q) empty
 
 -- | Nest (or indent) a document by a given number of positions
 -- (which may also be negative).  'nest' satisfies the laws:
@@ -584,17 +584,17 @@ mkUnion :: Doc -> Doc -> Doc
 mkUnion Empty _ = Empty
 mkUnion p q     = p `union_` q
 
-reduceAB :: Doc -> Doc
-reduceAB = snd . reduceAB'
-
 data IsEmpty = IsEmpty | NotEmpty
 
-reduceAB' :: Doc -> (IsEmpty, Doc)
-reduceAB' (Above  p g q) = eliminateEmpty Above  (reduceAB p) g (reduceAB' q)
-reduceAB' (Beside p g q) = eliminateEmpty Beside (reduceAB p) g (reduceAB' q)
-reduceAB' doc            = (NotEmpty, doc)
+reduceHoriz :: Doc -> (IsEmpty, Doc)
+reduceHoriz (Beside p g q) = eliminateEmpty Beside (snd (reduceHoriz p)) g (reduceHoriz q)
+reduceHoriz doc            = (NotEmpty, doc)
+
+reduceVert :: Doc -> (IsEmpty, Doc)
+reduceVert (Above  p g q) = eliminateEmpty Above  (snd (reduceVert p)) g (reduceVert q)
+reduceVert doc            = (NotEmpty, doc)
 
--- Left-arg-strict
+{-# INLINE eliminateEmpty #-}
 eliminateEmpty ::
   (Doc -> Bool -> Doc -> Doc) ->
   Doc -> Bool -> (IsEmpty, Doc) -> (IsEmpty, Doc)