diff options
| author | Eyal Lotem <eyal.lotem@gmail.com> | 2013-07-02 02:36:31 +0300 |
|---|---|---|
| committer | Thomas Miedema <thomasmiedema@gmail.com> | 2015-08-15 14:20:08 +0200 |
| commit | 8e62060a28f041b267a004967ad8efa3cb465500 (patch) | |
| tree | d8d7fd2e859bfa8d60e32f9f9abb33f91856a6a0 | |
| parent | cb828c0d43148dfdfa407a82310279ce98601233 (diff) | |
| download | haskell-wip/pretty.tar.gz | |
Special-case reduce for horiz/vertwip/pretty
This is a backport of c57c7a9dfc49617ba8d6e4fcdb019a3f29f1044c from
libraries/pretty.
| -rw-r--r-- | compiler/utils/Pretty.hs | 22 |
1 files 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) |