[Git][ghc/ghc][wip/multiline-strings] Address feedback
Brandon Chinn (@brandonchinn178)
gitlab at gitlab.haskell.org
Sat May 25 03:08:19 UTC 2024
Brandon Chinn pushed to branch wip/multiline-strings at Glasgow Haskell Compiler / GHC
Commits:
40f2993d by Brandon Chinn at 2024-05-25T12:07:59+09:00
Address feedback
- - - - -
4 changed files:
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Parser/CharClass.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/String.hs
Changes:
=====================================
compiler/GHC/Hs/Lit.hs
=====================================
@@ -30,6 +30,7 @@ import GHC.Types.Basic (PprPrec(..), topPrec )
import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
import GHC.Types.SourceText
import GHC.Core.Type
+import GHC.Utils.Misc (split)
import GHC.Utils.Outputable
import GHC.Hs.Extension
import Language.Haskell.Syntax.Expr ( HsExpr )
@@ -199,14 +200,7 @@ instance Outputable (HsLit (GhcPass p)) where
ppr (HsMultilineString st s) =
case st of
NoSourceText -> pprHsString s
- SourceText src ->
- vcat $ map text $ splitOn '\n' (unpackFS src)
- where
- splitOn c s =
- let (firstLine, rest) = break (== c) s
- in case rest of
- "" -> [firstLine]
- _ : rest -> firstLine : splitOn c rest
+ SourceText src -> vcat $ map text $ split '\n' (unpackFS src)
ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
ppr (HsInt _ i)
= pprWithSourceText (il_text i) (integer (il_value i))
=====================================
compiler/GHC/Parser/CharClass.hs
=====================================
@@ -43,7 +43,7 @@ is_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit,
is_ident = is_ctype cIdent
is_symbol = is_ctype cSymbol
is_any = is_ctype cAny
-is_space = is_ctype cSpace
+is_space = \c -> c <= '\x7f' && is_ctype cSpace c -- is_space only works for <= '\x7f' (#3751, #5425)
is_lower = is_ctype cLower
is_upper = is_ctype cUpper
is_digit = is_ctype cDigit
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -2251,7 +2251,7 @@ lex_string strType = do
'\\' -> do
case alexGetChar' i1 of
Just (c1, i2)
- | is_space' c1 -> lexStringGap (LexedChar c1 i1 : acc1) i2
+ | is_space c1 -> lexStringGap (LexedChar c1 i1 : acc1) i2
| otherwise -> lexString (LexedChar c1 i1 : acc1) i2
Nothing -> Left (LexStringCharLit, acc, i1)
_ | isAny c0 -> lexString acc1 i1
@@ -2278,7 +2278,7 @@ lex_string strType = do
let acc1 = LexedChar c0 i0 : acc0
case c0 of
'\\' -> lexString acc1 i1
- _ | is_space' c0 -> lexStringGap acc1 i1
+ _ | is_space c0 -> lexStringGap acc1 i1
_ -> Left (LexStringCharLit, acc, i0)
Nothing -> Left (LexStringCharLitEOF, acc, i0)
@@ -2371,13 +2371,6 @@ isAny :: Char -> Bool
isAny c | c > '\x7f' = isPrint c
| otherwise = is_any c
--- is_space only works for <= '\x7f' (#3751, #5425)
---
--- TODO: why not put this logic in is_space directly?
-is_space' :: Char -> Bool
-is_space' c | c > '\x7f' = False
- | otherwise = is_space c
-
-- | Returns a LexedString that, when iterated, lazily streams
-- successive characters from the AlexInput.
asLexedString :: AlexInput -> LexedString AlexInput
=====================================
compiler/GHC/Parser/String.hs
=====================================
@@ -17,6 +17,7 @@ import GHC.Prelude
import Control.Monad (forM_, guard, unless, when, (>=>))
import Data.Char (chr, isSpace, ord)
+import qualified Data.Foldable1 as Foldable1
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (listToMaybe, mapMaybe, maybeToList)
@@ -337,7 +338,7 @@ resolveMultilineString = pure . process
case NonEmpty.nonEmpty (excludeWsOnlyLines strLines) of
Nothing -> 0
Just strLines' ->
- minimum1 $
+ Foldable1.minimum $
flip NonEmpty.map strLines' $ \(LexedLine line _) ->
length $ takeWhile isLexedSpace line
in firstLine : mapLines (drop commonWSPrefix) strLines
@@ -350,10 +351,6 @@ resolveMultilineString = pure . process
LexedChar '\n' _ : s -> s
s -> s
- -- TODO: replace with Foldable1.minimum when GHC 9.6+ required to build
- minimum1 :: Ord a => NonEmpty a -> a
- minimum1 = minimum
-
-- -----------------------------------------------------------------------------
-- Helpers
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40f2993dce4fcdb5d99dd84453d9e8d90cd8997e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40f2993dce4fcdb5d99dd84453d9e8d90cd8997e
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240524/7d017dbf/attachment-0001.html>
More information about the ghc-commits
mailing list