Brandon Chinn pushed to branch wip/interpolated-strings-refactor at Glasgow Haskell Compiler / GHC Commits: 7caf2030 by Brandon Chinn at 2026-09-10T18:38:05-07:00 Add pprHsStringMulti, unify string ppr functions - - - - - 51d85318 by Brandon Chinn at 2026-09-10T18:38:05-07:00 Break out Language.Haskell.Syntax.StringMeta - - - - - 9 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/String.hs - compiler/GHC/Utils/Outputable.hs - + compiler/Language/Haskell/Syntax/StringMeta.hs - compiler/ghc.cabal.in - libraries/ghc-internal/src/GHC/Internal/Show.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -87,7 +87,6 @@ import GHC.Parser.HaddockLex import GHC.Parser.Annotation import GHC.Parser.Errors.Types import GHC.Parser.Errors.Ppr () -import GHC.Parser.String import GHC.Builtin.WiredIn.Types ( unitTyCon, unitDataCon, sumTyCon, @@ -97,6 +96,7 @@ import GHC.Builtin.WiredIn.Types unrestrictedFunTyCon ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import Language.Haskell.Syntax.StringMeta import Language.Haskell.Syntax.Text import qualified Data.Semigroup as Semi ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -141,6 +141,7 @@ import qualified GHC.Parser.Lexer.String as Lexer.String import GHC.Parser.String import Language.Haskell.Syntax.Module.Name (ModuleName(..)) +import Language.Haskell.Syntax.StringMeta import Language.Haskell.Syntax.Text } ===================================== compiler/GHC/Parser/String.hs ===================================== @@ -6,10 +6,6 @@ module GHC.Parser.String ( lexString, lexMultilineString, - -- * StringMeta - StringMeta (..), - defaultStrMeta, - -- * Unicode smart quote helpers isDoubleSmartQuote, isSingleSmartQuote, @@ -20,7 +16,6 @@ import GHC.Prelude hiding (getChar) import Control.Arrow ((>>>)) import Control.Monad (when) import Data.Char (chr, ord) -import Data.Data (Data) import qualified Data.Foldable1 as Foldable1 import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (listToMaybe, mapMaybe) @@ -37,7 +32,6 @@ import GHC.Parser.CharClass ( ) import GHC.Parser.Errors.Types (LexErr (..)) import GHC.Utils.Panic (panic) -import Language.Haskell.Syntax.Module.Name (ModuleName) type BufPos = Int data StringLexError = StringLexError LexErr BufPos @@ -288,20 +282,7 @@ isSingleSmartQuote = \case _ -> False -- ----------------------------------------------------------------------------- --- StringMeta - -data StringMeta = StringMeta - { strMetaMultiline :: Bool - , strMetaQualified :: Maybe ModuleName - } - deriving (Show, Data) - -defaultStrMeta :: StringMeta -defaultStrMeta = - StringMeta - { strMetaMultiline = False - , strMetaQualified = Nothing - } +-- QualifiedStrings {- Note [Implementation of QualifiedStrings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -61,7 +61,10 @@ module GHC.Utils.Outputable ( pprDebugAndThen, pprInfixVar, pprPrefixVar, - pprHsChar, pprHsString, pprHsBytes, + pprHsChar, + pprHsString, pprHsString', + pprHsStringMulti, pprHsStringMulti', + pprHsBytes, primFloatSuffix, primCharSuffix, primDoubleSuffix, primInt8Suffix, primWord8Suffix, @@ -165,7 +168,7 @@ import Data.Void import Control.DeepSeq (NFData(rnf)) import GHC.Fingerprint -import GHC.Show ( showMultiLineString ) +import GHC.Internal.Show ( showMultiLineString' ) import GHC.Utils.Exception import GHC.Exts (oneShot) @@ -1355,14 +1358,33 @@ pprHsChar :: Char -> SDoc pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32)) | otherwise = text (show c) --- | Special combinator for showing string literals. +-- | Special combinator for showing single-line string literals. pprHsString :: String -> SDoc -pprHsString fs = vcat (map text (showMultiLineString fs)) +pprHsString fs = char '"' <> pprHsString' fs <> char '"' + +-- | Like 'pprHsString' except without the outer quotes. +pprHsString' :: String -> SDoc +pprHsString' = vcat . map text . showMultiLineString' Nothing + +-- | Special combinator for showing multi-line string literals. +pprHsStringMulti :: FastString -> SDoc +pprHsStringMulti fs = text "\"\"\"" <> pprHsString' (unpackFS fs) <> text "\"\"\"" + +-- | Like 'pprHsStringMulti' except without the outer quotes. +pprHsStringMulti' :: String -> SDoc +pprHsStringMulti' = vcat . map text . showLitStringMultiline + where + showLitChars :: String -> ShowS + showLitChars [] s = s + showLitChars (c : cs) s = showLitChar c (showLitChars cs s) + + showLitStringMultiline :: String -> [String] + showLitStringMultiline = map (flip showLitChars "") . lines -- | Special combinator for showing bytestring literals. pprHsBytes :: ByteString -> SDoc pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs - in vcat (map text (showMultiLineString escaped)) <> char '#' + in char '"' <> pprHsString' escaped <> text "\"#" where escape :: Word8 -> String escape w = let c = chr (fromIntegral w) in if isAscii c ===================================== compiler/Language/Haskell/Syntax/StringMeta.hs ===================================== @@ -0,0 +1,27 @@ +module Language.Haskell.Syntax.StringMeta ( + StringMeta (..), + defaultStrMeta, +) where + +import Prelude + +import Language.Haskell.Syntax.Module.Name (ModuleName) + +-- libraries: +import Data.Data (Data) + +-- ----------------------------------------------------------------------------- +-- StringMeta + +data StringMeta = StringMeta + { strMetaMultiline :: Bool + , strMetaQualified :: Maybe ModuleName + } + deriving (Show, Data) + +defaultStrMeta :: StringMeta +defaultStrMeta = + StringMeta + { strMetaMultiline = False + , strMetaQualified = Nothing + } ===================================== compiler/ghc.cabal.in ===================================== @@ -1062,6 +1062,7 @@ Library Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity + Language.Haskell.Syntax.StringMeta Language.Haskell.Syntax.Text Language.Haskell.Syntax.Type ===================================== libraries/ghc-internal/src/GHC/Internal/Show.hs ===================================== @@ -42,7 +42,8 @@ module GHC.Internal.Show -- Instances for Show: (), [], Bool, Ordering, Int, Char -- Show support code - shows, showChar, showString, showMultiLineString, + shows, showChar, showString, + showMultiLineString, showMultiLineString', showParen, showList__, showCommaSpace, showSpace, showLitChar, showLitString, protectEsc, intToDigit, showSignedInt, @@ -421,13 +422,20 @@ showMultiLineString :: String -> [String] -- * wrap the entire thing in double quotes -- Example: @showMultiLineString "hello\ngoodbye\nblah"@ -- returns @["\"hello\\n\\", "\\goodbye\n\\", "\\blah\""]@ -showMultiLineString str - = go '\"' str +showMultiLineString = showMultiLineString' (Just '\"') + +-- | Like 'showMultiLineString' except using the given delimiter +showMultiLineString' :: Maybe Char -> String -> [String] +showMultiLineString' delim = map ($ "") . go showDelim where - go ch s = case break (== '\n') s of - (l, _:s'@(_:_)) -> (ch : showLitString l "\\n\\") : go '\\' s' - (l, "\n") -> [ch : showLitString l "\\n\""] - (l, _) -> [ch : showLitString l "\""] + showDelim = case delim of Just d -> showChar d; Nothing -> id + showNL = showString "\\n" + showBS = showChar '\\' + go pre s = + case break (== '\n') s of + (l, '\n':s'@(_:_)) -> (pre . showLitString l . showNL . showBS) : go showBS s' + (l, '\n':[]) -> (pre . showLitString l . showNL . showDelim) : [] + (l, _) -> (pre . showLitString l . showDelim) : [] isDec :: Char -> Bool isDec c = c >= '0' && c <= '9' ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -28,5 +28,6 @@ Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity +Language.Haskell.Syntax.StringMeta Language.Haskell.Syntax.Text Language.Haskell.Syntax.Type ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -303,5 +303,6 @@ Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity +Language.Haskell.Syntax.StringMeta Language.Haskell.Syntax.Text Language.Haskell.Syntax.Type View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d890d3d8e7a20d566954e7fd98ea0b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d890d3d8e7a20d566954e7fd98ea0b... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help