Partially fix whitespace parsing performance regression (#1512)
* Partially fix whitespace parsing performance regression This undoes some of the performance regression introduced in https://github.com/dhall-lang/dhall-haskell/pull/1483 Before #1483: ``` benchmarked Line comment time 11.86 ms (11.69 ms .. 11.98 ms) 0.999 R² (0.999 R² .. 1.000 R²) mean 11.84 ms (11.79 ms .. 11.89 ms) std dev 129.4 μs (107.2 μs .. 164.1 μs) benchmarked Block comment time 13.20 ms (13.00 ms .. 13.41 ms) 0.999 R² (0.998 R² .. 1.000 R²) mean 13.59 ms (13.41 ms .. 13.94 ms) std dev 600.0 μs (142.2 μs .. 953.7 μs) ``` After #1483: ``` benchmarked Line comment time 288.7 ms (282.8 ms .. 294.7 ms) 1.000 R² (0.999 R² .. 1.000 R²) mean 292.3 ms (290.8 ms .. 294.6 ms) std dev 3.156 ms (2.216 ms .. 4.546 ms) benchmarked Block comment time 286.2 ms (280.9 ms .. 292.6 ms) 0.999 R² (0.998 R² .. 1.000 R²) mean 290.6 ms (288.3 ms .. 292.9 ms) std dev 3.875 ms (2.866 ms .. 5.500 ms) ``` After this change: ``` benchmarked Line comment time 61.44 ms (60.37 ms .. 63.03 ms) 0.999 R² (0.997 R² .. 1.000 R²) mean 61.41 ms (60.74 ms .. 62.25 ms) std dev 1.341 ms (945.0 μs .. 1.901 ms) benchmarked Block comment time 61.83 ms (60.97 ms .. 63.14 ms) 0.999 R² (0.998 R² .. 1.000 R²) mean 61.16 ms (60.33 ms .. 61.85 ms) std dev 1.396 ms (1.011 ms .. 1.907 ms) ``` * Correctly parse `https://example.com usingBla` ... as caught by @sjakobi
This commit is contained in:
parent
7eec31d1d7
commit
b3b6bb4e1d
|
@ -262,14 +262,14 @@ parsers embedded = Parsers {..}
|
|||
a <- operatorExpression
|
||||
|
||||
let alternative4A = do
|
||||
try (whitespace *> _arrow)
|
||||
_arrow
|
||||
whitespace
|
||||
b <- expression
|
||||
whitespace
|
||||
return (Pi "_" a b)
|
||||
|
||||
let alternative4B = do
|
||||
try (whitespace *> _colon)
|
||||
_colon
|
||||
nonemptyWhitespace
|
||||
b <- expression
|
||||
case shallowDenote a of
|
||||
|
@ -289,9 +289,16 @@ parsers embedded = Parsers {..}
|
|||
makeOperatorExpression operatorParser subExpression =
|
||||
noted (do
|
||||
a <- subExpression
|
||||
|
||||
whitespace
|
||||
|
||||
b <- Text.Megaparsec.many $ do
|
||||
op <- try (whitespace *> operatorParser)
|
||||
op <- operatorParser
|
||||
|
||||
r <- subExpression
|
||||
|
||||
whitespace
|
||||
|
||||
return (\l -> l `op` r)
|
||||
return (foldl (\x f -> f x) a b) )
|
||||
|
||||
|
@ -705,36 +712,70 @@ parsers embedded = Parsers {..}
|
|||
nonEmptyRecordTypeOrLiteral = do
|
||||
a <- anyLabel
|
||||
|
||||
whitespace
|
||||
|
||||
let nonEmptyRecordType = do
|
||||
try (whitespace *> _colon)
|
||||
nonemptyWhitespace
|
||||
b <- expression
|
||||
e <- Text.Megaparsec.many (do
|
||||
try (whitespace *> _comma)
|
||||
whitespace
|
||||
c <- anyLabel
|
||||
whitespace
|
||||
_colon
|
||||
|
||||
nonemptyWhitespace
|
||||
|
||||
b <- expression
|
||||
|
||||
whitespace
|
||||
|
||||
e <- Text.Megaparsec.many (do
|
||||
_comma
|
||||
|
||||
whitespace
|
||||
|
||||
c <- anyLabel
|
||||
|
||||
whitespace
|
||||
|
||||
_colon
|
||||
|
||||
nonemptyWhitespace
|
||||
|
||||
d <- expression
|
||||
|
||||
whitespace
|
||||
|
||||
return (c, d) )
|
||||
|
||||
m <- toMap ((a, b) : e)
|
||||
|
||||
return (Record m)
|
||||
|
||||
let nonEmptyRecordLiteral = do
|
||||
try (whitespace *> _equal)
|
||||
whitespace
|
||||
b <- expression
|
||||
e <- Text.Megaparsec.many (do
|
||||
try (whitespace *> _comma)
|
||||
whitespace
|
||||
c <- anyLabel
|
||||
whitespace
|
||||
_equal
|
||||
|
||||
whitespace
|
||||
|
||||
b <- expression
|
||||
|
||||
whitespace
|
||||
|
||||
e <- Text.Megaparsec.many (do
|
||||
_comma
|
||||
|
||||
whitespace
|
||||
|
||||
c <- anyLabel
|
||||
|
||||
whitespace
|
||||
|
||||
_equal
|
||||
|
||||
whitespace
|
||||
|
||||
d <- expression
|
||||
|
||||
whitespace
|
||||
|
||||
return (c, d) )
|
||||
|
||||
m <- toMap ((a, b) : e)
|
||||
|
||||
return (RecordLit m)
|
||||
|
||||
nonEmptyRecordType <|> nonEmptyRecordLiteral
|
||||
|
@ -840,10 +881,8 @@ local = do
|
|||
http :: Parser ImportType
|
||||
http = do
|
||||
url <- httpRaw
|
||||
headers <- optional (try $ do
|
||||
whitespace
|
||||
_using
|
||||
nonemptyWhitespace
|
||||
headers <- optional (do
|
||||
try (whitespace *> _using *> nonemptyWhitespace)
|
||||
importExpression import_ )
|
||||
return (Remote (url { headers }))
|
||||
|
||||
|
@ -905,10 +944,9 @@ import_ = (do
|
|||
importMode <- alternative <|> pure Code
|
||||
return (Import {..}) ) <?> "import"
|
||||
where
|
||||
alternative = try $ do
|
||||
whitespace
|
||||
_as
|
||||
nonemptyWhitespace
|
||||
alternative = do
|
||||
try (whitespace *> _as *> nonemptyWhitespace)
|
||||
|
||||
(_Text >> pure RawText) <|> (_Location >> pure Location)
|
||||
|
||||
-- | Same as @Data.Text.splitOn@, except always returning a `NonEmpty` result
|
||||
|
|
|
@ -89,7 +89,8 @@ notesInLetInLet = do
|
|||
(Just " ")
|
||||
Nothing
|
||||
(Just " ")
|
||||
(Note "0" (NaturalLit 0)))
|
||||
(Note "0 " (Note "0" (NaturalLit 0)))
|
||||
)
|
||||
-- This 'Let' isn't wrapped in a 'Note'!
|
||||
(Let
|
||||
(Binding
|
||||
|
@ -98,7 +99,7 @@ notesInLetInLet = do
|
|||
(Just " ")
|
||||
Nothing
|
||||
(Just " ")
|
||||
(Note "1" (NaturalLit 1))
|
||||
(Note "1 " (Note "1" (NaturalLit 1)))
|
||||
)
|
||||
(Note "let z = 2 in x"
|
||||
(Let
|
||||
|
@ -108,10 +109,14 @@ notesInLetInLet = do
|
|||
(Just " ")
|
||||
Nothing
|
||||
(Just " ")
|
||||
(Note "2" (NaturalLit 2))
|
||||
(Note "2 " (Note "2" (NaturalLit 2)))
|
||||
)
|
||||
(Note "x" (Var (V "x" 0)))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(Note "x"
|
||||
(Var (V "x" 0))))))))
|
||||
|
||||
let msg = "Unexpected parse result"
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user