Skip to content

Eager on pathologically oversized string literals (#478) #479

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
mgajda wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Eager on pathologically oversized string literals (#478) #479

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 15 additions & 8 deletions src/Language/Haskell/Exts/InternalLexer.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
Expand Down Expand Up @@ -1143,23 +1144,23 @@ lexCharacter = do -- We need to keep track of not only character constants but


lexString :: Lex a Token
lexString = loop ("","")
lexString = loop [] []
where
loop (s,raw) = do
loop !s !raw = do
r <- getInput
exts <- getExtensionsL
case r of
'\\':'&':_ -> do
discard 2
loop (s, '&':'\\':raw)
loop s ('&':'\\':raw)
'\\':c:_ | isSpace c -> do
discard 1
wcs <- lexWhiteChars
matchChar '\\' "Illegal character in string gap"
loop (s, '\\':reverse wcs ++ '\\':raw)
loop s ('\\':revAppend wcs ('\\':raw))
| otherwise -> do
(ce, str) <- lexEscape
loop (ce:s, reverse str ++ '\\':raw)
loop (ce `seq` ce : s) (revAppend str ('\\':raw))
'"':'#':_ | MagicHash `elem` exts -> do
discard 2
return (StringHash (reverse s, reverse raw))
Expand All @@ -1168,9 +1169,13 @@ lexString = loop ("","")
return (StringTok (reverse s, reverse raw))
c:_ | c /= '\n' -> do
discard 1
loop (c:s, c:raw)
loop (c:s) (c:raw)
_ -> fail "Improperly terminated string"

revAppend :: [a] -> [a] -> [a]
revAppend [] ys = ys
revAppend (x:xs) ys = revAppend xs (x:ys)

lexWhiteChars :: Lex a String
lexWhiteChars = do
s <- getInput
Expand Down Expand Up @@ -1301,8 +1306,10 @@ lexDecimal = do

-- Stolen from Hugs's Prelude
parseInteger :: Integer -> String -> Integer
parseInteger radix ds =
foldl1 (\n d -> n * radix + d) (map (toInteger . digitToInt) ds)
parseInteger radix = go 0
where
go !acc [] = acc
go !acc (d:ds) = go (acc * radix + toInteger (digitToInt d)) ds

flagKW :: Token -> Lex a ()
flagKW t =
Expand Down