diff options
| -rw-r--r-- | compiler/GHC/Utils/Outputable.hs | 14 |
1 files changed, 13 insertions, 1 deletions
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs index 23bceff20a..736d609def 100644 --- a/compiler/GHC/Utils/Outputable.hs +++ b/compiler/GHC/Utils/Outputable.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} {- (c) The University of Glasgow 2006-2012 @@ -121,6 +122,7 @@ import qualified Data.List.NonEmpty as NEL import GHC.Fingerprint import GHC.Show ( showMultiLineString ) import GHC.Utils.Exception +import GHC.Exts (oneShot) {- ************************************************************************ @@ -304,7 +306,17 @@ code (either C or assembly), or generating interface files. -- To display an 'SDoc', use 'printSDoc', 'printSDocLn', 'bufLeftRenderSDoc', -- or 'renderWithContext'. Avoid calling 'runSDoc' directly as it breaks the -- abstraction layer. -newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc } +newtype SDoc = SDoc' (SDocContext -> Doc) + +-- See Note [The one-shot state monad trick] in GHC.Utils.Monad +{-# COMPLETE SDoc #-} +pattern SDoc :: (SDocContext -> Doc) -> SDoc +pattern SDoc m <- SDoc' m + where + SDoc m = SDoc' (oneShot m) + +runSDoc :: SDoc -> (SDocContext -> Doc) +runSDoc (SDoc m) = m data SDocContext = SDC { sdocStyle :: !PprStyle |