Brandon Chinn pushed to branch wip/interpolated-strings-refactor at Glasgow Haskell Compiler / GHC

Commits:

13 changed files:

Changes:

  • compiler/GHC/Parser.y
    ... ... @@ -87,7 +87,6 @@ import GHC.Parser.HaddockLex
    87 87 
     import GHC.Parser.Annotation
    88 88 
     import GHC.Parser.Errors.Types
    89 89 
     import GHC.Parser.Errors.Ppr ()
    90 
    -import GHC.Parser.String
    91 90
    92 91 
     import GHC.Builtin.WiredIn.Types
    93 92 
                 ( unitTyCon, unitDataCon, sumTyCon,
    ... ... @@ -97,6 +96,7 @@ import GHC.Builtin.WiredIn.Types
    97 96 
                   unrestrictedFunTyCon )
    98 97
    99 98 
     import Language.Haskell.Syntax.Basic (FieldLabelString(..))
    99 
    +import Language.Haskell.Syntax.StringMeta
    100 100 
     import Language.Haskell.Syntax.Text
    101 101
    102 102 
     import qualified Data.Semigroup as Semi

  • compiler/GHC/Parser/Lexer.x
    ... ... @@ -141,6 +141,7 @@ import qualified GHC.Parser.Lexer.String as Lexer.String
    141 141 
     import GHC.Parser.String
    142 142
    143 143 
     import Language.Haskell.Syntax.Module.Name (ModuleName(..))
    144 
    +import Language.Haskell.Syntax.StringMeta
    144 145 
     import Language.Haskell.Syntax.Text
    145 146 
     }
    146 147

  • compiler/GHC/Parser/String.hs
    ... ... @@ -6,10 +6,6 @@ module GHC.Parser.String (
    6 6 
       lexString,
    7 7 
       lexMultilineString,
    8 8
    9 
    -  -- * StringMeta
    10 
    -  StringMeta (..),
    11 
    -  defaultStrMeta,
    12 
    -
    13 9 
       -- * Unicode smart quote helpers
    14 10 
       isDoubleSmartQuote,
    15 11 
       isSingleSmartQuote,
    ... ... @@ -20,7 +16,6 @@ import GHC.Prelude hiding (getChar)
    20 16 
     import Control.Arrow ((>>>))
    21 17 
     import Control.Monad (when)
    22 18 
     import Data.Char (chr, ord)
    23 
    -import Data.Data (Data)
    24 19 
     import qualified Data.Foldable1 as Foldable1
    25 20 
     import qualified Data.List.NonEmpty as NonEmpty
    26 21 
     import Data.Maybe (listToMaybe, mapMaybe)
    ... ... @@ -37,7 +32,6 @@ import GHC.Parser.CharClass (
    37 32 
      )
    38 33 
     import GHC.Parser.Errors.Types (LexErr (..))
    39 34 
     import GHC.Utils.Panic (panic)
    40 
    -import Language.Haskell.Syntax.Module.Name (ModuleName)
    41 35
    42 36 
     type BufPos = Int
    43 37 
     data StringLexError = StringLexError LexErr BufPos
    ... ... @@ -288,20 +282,7 @@ isSingleSmartQuote = \case
    288 282 
       _ -> False
    289 283
    290 284 
     -- -----------------------------------------------------------------------------
    291 
    --- StringMeta
    292 
    -
    293 
    -data StringMeta = StringMeta
    294 
    -  { strMetaMultiline  :: Bool
    295 
    -  , strMetaQualified  :: Maybe ModuleName
    296 
    -  }
    297 
    -  deriving (Show, Data)
    298 
    -
    299 
    -defaultStrMeta :: StringMeta
    300 
    -defaultStrMeta =
    301 
    -  StringMeta
    302 
    -    { strMetaMultiline = False
    303 
    -    , strMetaQualified = Nothing
    304 
    -    }
    285 
    +-- QualifiedStrings
    305 286
    306 287 
     {- Note [Implementation of QualifiedStrings]
    307 288 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  • compiler/GHC/Utils/Outputable.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE PatternSynonyms #-}
    2 3 
     {-# LANGUAGE TypeFamilyDependencies #-}
    3 4
    ... ... @@ -61,7 +62,10 @@ module GHC.Utils.Outputable (
    61 62 
             pprDebugAndThen,
    62 63
    63 64 
             pprInfixVar, pprPrefixVar,
    64 
    -        pprHsChar, pprHsString, pprHsBytes,
    65 
    +        pprHsChar,
    66 
    +        pprHsString, pprHsString',
    67 
    +        pprHsStringMulti, pprHsStringMulti',
    68 
    +        pprHsBytes,
    65 69
    66 70 
             primFloatSuffix, primCharSuffix, primDoubleSuffix,
    67 71 
             primInt8Suffix, primWord8Suffix,
    ... ... @@ -165,7 +169,11 @@ import Data.Void
    165 169 
     import Control.DeepSeq (NFData(rnf))
    166 170
    167 171 
     import GHC.Fingerprint
    168 
    -import GHC.Show         ( showMultiLineString )
    172 
    +#if MIN_VERSION_base(4,23,0)
    173 
    +import GHC.Show (showMultiLineString')
    174 
    +#else
    175 
    +import GHC.Show (showLitString)
    176 
    +#endif
    169 177 
     import GHC.Utils.Exception
    170 178 
     import GHC.Exts (oneShot)
    171 179
    ... ... @@ -1355,14 +1363,48 @@ pprHsChar :: Char -> SDoc
    1355 1363 
     pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
    1356 1364 
                 | otherwise      = text (show c)
    1357 1365
    1358 
    --- | Special combinator for showing string literals.
    1366 
    +-- | Special combinator for showing single-line string literals.
    1359 1367 
     pprHsString :: String -> SDoc
    1360 
    -pprHsString fs = vcat (map text (showMultiLineString fs))
    1368 
    +pprHsString fs = char '"' <> pprHsString' fs <> char '"'
    1369 
    +
    1370 
    +-- | Like 'pprHsString' except without the outer quotes.
    1371 
    +pprHsString' :: String -> SDoc
    1372 
    +pprHsString' = vcat . map text . showMultiLineString' Nothing
    1373 
    +
    1374 
    +-- | Special combinator for showing multi-line string literals.
    1375 
    +pprHsStringMulti :: FastString -> SDoc
    1376 
    +pprHsStringMulti fs = text "\"\"\"" <> pprHsString' (unpackFS fs) <> text "\"\"\""
    1377 
    +
    1378 
    +-- | Like 'pprHsStringMulti' except without the outer quotes.
    1379 
    +pprHsStringMulti' :: String -> SDoc
    1380 
    +pprHsStringMulti' = vcat . map text . showLitStringMultiline
    1381 
    +  where
    1382 
    +    showLitChars :: String -> ShowS
    1383 
    +    showLitChars [] s = s
    1384 
    +    showLitChars (c : cs) s = showLitChar c (showLitChars cs s)
    1385 
    +
    1386 
    +    showLitStringMultiline :: String -> [String]
    1387 
    +    showLitStringMultiline = map (flip showLitChars "") . lines
    1388 
    +
    1389 
    +#if !MIN_VERSION_base(4,23,0)
    1390 
    +-- Copied from GHC.Internal.Show
    1391 
    +showMultiLineString' :: Maybe Char -> String -> [String]
    1392 
    +showMultiLineString' delim = map ($ "") . go showDelim
    1393 
    +  where
    1394 
    +    showDelim = case delim of Just d -> showChar d; Nothing -> id
    1395 
    +    showNL = showString "\\n"
    1396 
    +    showBS = showChar '\\'
    1397 
    +    go pre s =
    1398 
    +      case break (== '\n') s of
    1399 
    +        (l, '\n':s'@(_:_)) -> (pre . showLitString l . showNL . showBS) : go showBS s'
    1400 
    +        (l, '\n':[])       -> (pre . showLitString l . showNL . showDelim) : []
    1401 
    +        (l, _)             -> (pre . showLitString l . showDelim) : []
    1402 
    +#endif
    1361 1403
    1362 1404 
     -- | Special combinator for showing bytestring literals.
    1363 1405 
     pprHsBytes :: ByteString -> SDoc
    1364 1406 
     pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs
    1365 
    -                in vcat (map text (showMultiLineString escaped)) <> char '#'
    1407 
    +                in char '"' <> pprHsString' escaped <> text "\"#"
    1366 1408 
         where escape :: Word8 -> String
    1367 1409 
               escape w = let c = chr (fromIntegral w)
    1368 1410 
                          in if isAscii c

  • compiler/Language/Haskell/Syntax/StringMeta.hs
    1 
    +module Language.Haskell.Syntax.StringMeta (
    2 
    +  StringMeta (..),
    3 
    +  defaultStrMeta,
    4 
    +) where
    5 
    +
    6 
    +import Prelude
    7 
    +
    8 
    +import Language.Haskell.Syntax.Module.Name (ModuleName)
    9 
    +
    10 
    +-- libraries:
    11 
    +import Data.Data (Data)
    12 
    +
    13 
    +-- -----------------------------------------------------------------------------
    14 
    +-- StringMeta
    15 
    +
    16 
    +data StringMeta = StringMeta
    17 
    +  { strMetaMultiline  :: Bool
    18 
    +  , strMetaQualified  :: Maybe ModuleName
    19 
    +  }
    20 
    +  deriving (Show, Data)
    21 
    +
    22 
    +defaultStrMeta :: StringMeta
    23 
    +defaultStrMeta =
    24 
    +  StringMeta
    25 
    +    { strMetaMultiline = False
    26 
    +    , strMetaQualified = Nothing
    27 
    +    }

  • compiler/ghc.cabal.in
    ... ... @@ -1062,6 +1062,7 @@ Library
    1062 1062 
             Language.Haskell.Syntax.Module.Name
    1063 1063 
             Language.Haskell.Syntax.Pat
    1064 1064 
             Language.Haskell.Syntax.Specificity
    1065 
    +        Language.Haskell.Syntax.StringMeta
    1065 1066 
             Language.Haskell.Syntax.Text
    1066 1067 
             Language.Haskell.Syntax.Type
    1067 1068

  • libraries/base/src/GHC/Show.hs
    ... ... @@ -18,7 +18,7 @@ module GHC.Show
    18 18 
             Show(..), ShowS,
    19 19
    20 20 
             -- * Show support code
    21 
    -        shows, showChar, showString, showMultiLineString,
    21 
    +        shows, showChar, showString, showMultiLineString, showMultiLineString',
    22 22 
             showParen, showList__, showCommaSpace, showSpace,
    23 23 
             showLitChar, showLitString, protectEsc,
    24 24 
             intToDigit, showSignedInt,

  • libraries/ghc-internal/src/GHC/Internal/Show.hs
    ... ... @@ -42,7 +42,8 @@ module GHC.Internal.Show
    42 42 
             -- Instances for Show: (), [], Bool, Ordering, Int, Char
    43 43
    44 44 
             -- Show support code
    45 
    -        shows, showChar, showString, showMultiLineString,
    45 
    +        shows, showChar, showString,
    46 
    +        showMultiLineString, showMultiLineString',
    46 47 
             showParen, showList__, showCommaSpace, showSpace,
    47 48 
             showLitChar, showLitString, protectEsc,
    48 49 
             intToDigit, showSignedInt,
    ... ... @@ -421,13 +422,20 @@ showMultiLineString :: String -> [String]
    421 422 
     --   * wrap the entire thing in double quotes
    422 423 
     -- Example:  @showMultiLineString "hello\ngoodbye\nblah"@
    423 424 
     -- returns   @["\"hello\\n\\", "\\goodbye\n\\", "\\blah\""]@
    424 
    -showMultiLineString str
    425 
    -  = go '\"' str
    425 
    +showMultiLineString = showMultiLineString' (Just '\"')
    426 
    +
    427 
    +-- | Like 'showMultiLineString' except using the given delimiter
    428 
    +showMultiLineString' :: Maybe Char -> String -> [String]
    429 
    +showMultiLineString' delim = map ($ "") . go showDelim
    426 430 
       where
    427 
    -    go ch s = case break (== '\n') s of
    428 
    -                (l, _:s'@(_:_)) -> (ch : showLitString l "\\n\\") : go '\\' s'
    429 
    -                (l, "\n")       -> [ch : showLitString l "\\n\""]
    430 
    -                (l, _)          -> [ch : showLitString l "\""]
    431 
    +    showDelim = case delim of Just d -> showChar d; Nothing -> id
    432 
    +    showNL = showString "\\n"
    433 
    +    showBS = showChar '\\'
    434 
    +    go pre s =
    435 
    +      case break (== '\n') s of
    436 
    +        (l, '\n':s'@(_:_)) -> (pre . showLitString l . showNL . showBS) : go showBS s'
    437 
    +        (l, '\n':[])       -> (pre . showLitString l . showNL . showDelim) : []
    438 
    +        (l, _)             -> (pre . showLitString l . showDelim) : []
    431 439
    432 440 
     isDec :: Char -> Bool
    433 441 
     isDec c = c >= '0' && c <= '9'

  • testsuite/tests/count-deps/CountDepsAst.stdout
    ... ... @@ -28,5 +28,6 @@ Language.Haskell.Syntax.Lit
    28 28 
     Language.Haskell.Syntax.Module.Name
    29 29 
     Language.Haskell.Syntax.Pat
    30 30 
     Language.Haskell.Syntax.Specificity
    31 
    +Language.Haskell.Syntax.StringMeta
    31 32 
     Language.Haskell.Syntax.Text
    32 33 
     Language.Haskell.Syntax.Type

  • testsuite/tests/count-deps/CountDepsParser.stdout
    ... ... @@ -303,5 +303,6 @@ Language.Haskell.Syntax.Lit
    303 303 
     Language.Haskell.Syntax.Module.Name
    304 304 
     Language.Haskell.Syntax.Pat
    305 305 
     Language.Haskell.Syntax.Specificity
    306 
    +Language.Haskell.Syntax.StringMeta
    306 307 
     Language.Haskell.Syntax.Text
    307 308 
     Language.Haskell.Syntax.Type

  • testsuite/tests/interface-stability/base-exports.stdout
    No preview for this file type
  • testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
    No preview for this file type
  • testsuite/tests/interface-stability/base-exports.stdout-mingw32
    No preview for this file type

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/compare/51d85318eb6055a039efd1dda036da86e627c14b...2a221268f0f24041f89a04f3fc5103c839d73ca5 at 1789180638