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:
Gabriel Gonzalez 2019-11-03 18:12:02 -08:00 committed by mergify[bot]
parent 7eec31d1d7
commit b3b6bb4e1d
2 changed files with 63 additions and 20 deletions

View File

@ -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)
_colon
nonemptyWhitespace
b <- expression
whitespace
e <- Text.Megaparsec.many (do
try (whitespace *> _comma)
_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)
_equal
whitespace
b <- expression
whitespace
e <- Text.Megaparsec.many (do
try (whitespace *> _comma)
_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

View File

@ -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"