[commit: packages/pretty] large_docs: Special-case reduce for horiz/vert (c57c7a9)

git at git.haskell.org git at git.haskell.org
Fri Jan 23 22:50:10 UTC 2015


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

On branch  : large_docs
Link       : http://git.haskell.org/packages/pretty.git/commitdiff/c57c7a9dfc49617ba8d6e4fcdb019a3f29f1044c

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

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

    Special-case reduce for horiz/vert


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

c57c7a9dfc49617ba8d6e4fcdb019a3f29f1044c
 src/Text/PrettyPrint/HughesPJ.hs | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/Text/PrettyPrint/HughesPJ.hs b/src/Text/PrettyPrint/HughesPJ.hs
index f3f3bc2..c45f691 100644
--- a/src/Text/PrettyPrint/HughesPJ.hs
+++ b/src/Text/PrettyPrint/HughesPJ.hs
@@ -433,15 +433,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:
@@ -488,17 +488,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)



More information about the ghc-commits mailing list