From 8e62060a28f041b267a004967ad8efa3cb465500 Mon Sep 17 00:00:00 2001
From: Eyal Lotem <eyal.lotem@gmail.com>
Date: Tue, 2 Jul 2013 02:36:31 +0300
Subject: Special-case reduce for horiz/vert

This is a backport of c57c7a9dfc49617ba8d6e4fcdb019a3f29f1044c from
libraries/pretty.
---
 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 49be9ee72b..ba717f359e 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)
-- 
cgit v1.2.1