diff options
| author | Thomas Miedema <thomasmiedema@gmail.com> | 2015-08-05 11:31:21 +0200 |
|---|---|---|
| committer | Thomas Miedema <thomasmiedema@gmail.com> | 2015-08-12 11:19:14 +0200 |
| commit | 5d57087e314bd484dbe14958f9b422be3ac6641a (patch) | |
| tree | c897800dad241921fd7cafbbeaebffcf6fe32c0e | |
| parent | bcfae08c0be0fa8604e2025733dfae57e37c2083 (diff) | |
| download | haskell-5d57087e314bd484dbe14958f9b422be3ac6641a.tar.gz | |
Pretty: fix a broken invariant (#10735)
This is a backport of a bug fix from
6cfbd0444981c074bae10a3cf72733bcb8597bef in libraries/pretty:
Fix a broken invariant
Patch from #694, for the problem "empty is an identity for <> and $$" is
currently broken by eg. isEmpty (empty<>empty)"
| -rw-r--r-- | compiler/utils/Pretty.hs | 18 |
1 files changed, 14 insertions, 4 deletions
diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 99566d36ea..d07bd3d433 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -623,12 +623,17 @@ union_ = Union -- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty. -- ($$) :: Doc -> Doc -> Doc -p $$ q = Above p False q +p $$ q = above_ p False q -- | Above, with no overlapping. -- '$+$' is associative, with identity 'empty'. ($+$) :: Doc -> Doc -> Doc -p $+$ q = Above p True q +p $+$ q = above_ p True q + +above_ :: Doc -> Bool -> Doc -> Doc +above_ p _ Empty = p +above_ Empty _ q = q +above_ p g q = Above p g q above :: Doc -> Bool -> RDoc -> RDoc above (Above p g1 q1) g2 q2 = above p g1 (above q1 g2 q2) @@ -679,12 +684,17 @@ nilAboveNest g k q | not g && k > 0 -- No newline if no overlap -- | Beside. -- '<>' is associative, with identity 'empty'. (<>) :: Doc -> Doc -> Doc -p <> q = Beside p False q +p <> q = beside_ p False q -- | Beside, separated by space, unless one of the arguments is 'empty'. -- '<+>' is associative, with identity 'empty'. (<+>) :: Doc -> Doc -> Doc -p <+> q = Beside p True q +p <+> q = beside_ p True q + +beside_ :: Doc -> Bool -> Doc -> Doc +beside_ p _ Empty = p +beside_ Empty _ q = q +beside_ p g q = Beside p g q -- Specification: beside g p q = p <g> q beside :: Doc -> Bool -> RDoc -> RDoc |