diff options
Diffstat (limited to 'compiler/utils')
| -rw-r--r-- | compiler/utils/GhcPrelude.hs | 6 | ||||
| -rw-r--r-- | compiler/utils/Outputable.hs | 23 | ||||
| -rw-r--r-- | compiler/utils/Pretty.hs | 11 |
3 files changed, 18 insertions, 22 deletions
diff --git a/compiler/utils/GhcPrelude.hs b/compiler/utils/GhcPrelude.hs index dd78f15573..fa028b2d56 100644 --- a/compiler/utils/GhcPrelude.hs +++ b/compiler/utils/GhcPrelude.hs @@ -12,11 +12,7 @@ module GhcPrelude (module X) where --- We export the 'Semigroup' class but w/o the (<>) operator to avoid --- clashing with the (Outputable.<>) operator which is heavily used --- through GHC's code-base. - -import Prelude as X hiding ((<>)) +import Prelude as X import Data.Foldable as X (foldl') {- diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index d36faa4724..a65dda8f75 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -700,12 +700,14 @@ unicode unicode plain = sdocOption sdocCanUseUnicode $ \case True -> unicode False -> plain +infixr 6 <+> -- matches that of (Semigroup.<>) +infixl 5 $$, $+$ + nest :: Int -> SDoc -> SDoc -- ^ Indent 'SDoc' some specified amount -(<>) :: SDoc -> SDoc -> SDoc --- ^ Join two 'SDoc' together horizontally without a gap (<+>) :: SDoc -> SDoc -> SDoc --- ^ Join two 'SDoc' together horizontally with a gap between them +-- ^ Join two 'SDoc' together horizontally with a gap between them. +-- Use '(<>)' to join without a gap. ($$) :: SDoc -> SDoc -> SDoc -- ^ Join two 'SDoc' together vertically; if there is -- no vertical overlap it "dovetails" the two onto one line @@ -713,11 +715,14 @@ nest :: Int -> SDoc -> SDoc -- ^ Join two 'SDoc' together vertically nest n d = SDoc $ Pretty.nest n . runSDoc d -(<>) d1 d2 = SDoc $ \sty -> (Pretty.<>) (runSDoc d1 sty) (runSDoc d2 sty) (<+>) d1 d2 = SDoc $ \sty -> (Pretty.<+>) (runSDoc d1 sty) (runSDoc d2 sty) ($$) d1 d2 = SDoc $ \sty -> (Pretty.$$) (runSDoc d1 sty) (runSDoc d2 sty) ($+$) d1 d2 = SDoc $ \sty -> (Pretty.$+$) (runSDoc d1 sty) (runSDoc d2 sty) +-- | Join two 'SDoc' together horizontally without a gap +instance Semigroup SDoc where + d1 <> d2 = SDoc $ \sty -> runSDoc d1 sty <> runSDoc d2 sty + hcat :: [SDoc] -> SDoc -- ^ Concatenate 'SDoc' horizontally hsep :: [SDoc] -> SDoc @@ -790,8 +795,8 @@ coloured col sdoc = sdocOption sdocShouldUseColor $ \case ctx@SDC{ sdocLastColour = lastCol, sdocStyle = PprUser _ _ Coloured } -> let ctx' = ctx{ sdocLastColour = lastCol `mappend` col } in Pretty.zeroWidthText (Col.renderColour col) - Pretty.<> runSDoc sdoc ctx' - Pretty.<> Pretty.zeroWidthText (Col.renderColourAfresh lastCol) + <> runSDoc sdoc ctx' + <> Pretty.zeroWidthText (Col.renderColourAfresh lastCol) ctx -> runSDoc sdoc ctx False -> sdoc @@ -1179,9 +1184,9 @@ speakNOf n d = speakN n <+> d <> char 's' -- E.g. "three arguments -- > plural [] = char 's' -- > plural ["Hello"] = empty -- > plural ["Hello", "World"] = char 's' -plural :: [a] -> SDoc -plural [_] = empty -- a bit frightening, but there you are -plural _ = char 's' +plural :: String -> [a] -> SDoc +plural s [_] = text s -- a bit frightening, but there you are +plural s _ = text (s ++ "s") -- | Determines the form of to be appropriate for the length of a list: -- diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 5adfdd7699..6e8686a62d 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -201,8 +201,7 @@ But it doesn't work, for if x=empty, we would have -- --------------------------------------------------------------------------- -- Operator fixity -infixl 6 <> -infixl 6 <+> +infixr 6 <+> -- matches that of (Semigroup.<>) infixl 5 $$, $+$ @@ -659,14 +658,10 @@ nilAboveNest g k q | not g && k > 0 -- No newline if no overlap -- --------------------------------------------------------------------------- -- Horizontal composition @<>@ --- We intentionally avoid Data.Monoid.(<>) here due to interactions of --- Data.Monoid.(<>) and (<+>). See --- http://www.haskell.org/pipermail/libraries/2011-November/017066.html - -- | Beside. -- '<>' is associative, with identity 'empty'. -(<>) :: Doc -> Doc -> Doc -p <> q = beside_ p False q +instance Semigroup Doc where + p <> q = beside_ p False q -- | Beside, separated by space, unless one of the arguments is 'empty'. -- '<+>' is associative, with identity 'empty'. |