Fix parsing of variables with keyword prefixes (#1584)
* Fix parsing of variables with keyword prefixes Fixes https://github.com/dhall-lang/dhall-haskell/issues/1583 Note that one prefix is not yet supported: `missing`, since fixing that is not easy for the current parsing implementation (as far as I can tell). * Add regression test ... as suggested by @sjakobi I'm not upstreaming this into the standard test suite yet because the current parser cannot handle `missing`, which would be necessary to generate the corresponding CBOR
This commit is contained in:
parent
de51dafe8e
commit
7d01d4685a
|
@ -162,24 +162,19 @@ parsers embedded = Parsers {..}
|
|||
return (Lam a b c)
|
||||
|
||||
alternative1 = do
|
||||
_if
|
||||
nonemptyWhitespace
|
||||
try (_if *> nonemptyWhitespace)
|
||||
a <- expression
|
||||
whitespace
|
||||
_then
|
||||
nonemptyWhitespace
|
||||
try (_then *> nonemptyWhitespace)
|
||||
b <- expression
|
||||
whitespace
|
||||
_else
|
||||
nonemptyWhitespace
|
||||
try (_else *> nonemptyWhitespace)
|
||||
c <- expression
|
||||
return (BoolIf a b c)
|
||||
|
||||
alternative2 = do
|
||||
let binding = do
|
||||
_let
|
||||
|
||||
src0 <- src nonemptyWhitespace
|
||||
src0 <- try (_let *> src nonemptyWhitespace)
|
||||
|
||||
c <- label
|
||||
|
||||
|
@ -208,9 +203,7 @@ parsers embedded = Parsers {..}
|
|||
|
||||
as <- Data.List.NonEmpty.some1 binding
|
||||
|
||||
_in
|
||||
|
||||
nonemptyWhitespace
|
||||
try (_in *> nonemptyWhitespace)
|
||||
|
||||
b <- expression
|
||||
|
||||
|
@ -234,9 +227,7 @@ parsers embedded = Parsers {..}
|
|||
return (Dhall.Syntax.wrapInLets as b)
|
||||
|
||||
alternative3 = do
|
||||
_forall
|
||||
whitespace
|
||||
_openParens
|
||||
try (_forall *> whitespace *> _openParens)
|
||||
whitespace
|
||||
a <- label
|
||||
whitespace
|
||||
|
@ -252,9 +243,7 @@ parsers embedded = Parsers {..}
|
|||
return (Pi a b c)
|
||||
|
||||
alternative4 = do
|
||||
_assert
|
||||
whitespace
|
||||
_colon
|
||||
try (_assert *> whitespace *> _colon)
|
||||
nonemptyWhitespace
|
||||
a <- expression
|
||||
return (Assert a)
|
||||
|
@ -321,7 +310,7 @@ parsers embedded = Parsers {..}
|
|||
]
|
||||
|
||||
applicationExpression = do
|
||||
f <- (Some <$ _Some <* nonemptyWhitespace)
|
||||
f <- (Some <$ try (_Some <* nonemptyWhitespace))
|
||||
<|> return id
|
||||
a <- noted importExpression_
|
||||
bs <- Text.Megaparsec.many . try $ do
|
||||
|
@ -433,16 +422,14 @@ parsers embedded = Parsers {..}
|
|||
alternative06 = listLiteral
|
||||
|
||||
alternative07 = do
|
||||
_merge
|
||||
nonemptyWhitespace
|
||||
try (_merge *> nonemptyWhitespace)
|
||||
a <- importExpression_
|
||||
nonemptyWhitespace
|
||||
b <- importExpression_ <?> "second argument to ❰merge❱"
|
||||
return (Merge a b Nothing)
|
||||
|
||||
alternative08 = do
|
||||
_toMap
|
||||
nonemptyWhitespace
|
||||
try (_toMap *> nonemptyWhitespace)
|
||||
a <- importExpression_
|
||||
return (ToMap a Nothing)
|
||||
|
||||
|
|
|
@ -42,6 +42,7 @@ tests =
|
|||
, issue1131a
|
||||
, issue1131b
|
||||
, issue1341
|
||||
, issue1584
|
||||
, parsing0
|
||||
, typeChecking0
|
||||
, typeChecking1
|
||||
|
@ -180,6 +181,13 @@ issue1341 = Test.Tasty.HUnit.testCase "Issue #1341" (do
|
|||
let msg = "NaN shouldn't contain any free variables"
|
||||
Test.Tasty.HUnit.assertEqual msg False actual)
|
||||
|
||||
issue1584 :: TestTree
|
||||
issue1584 = Test.Tasty.HUnit.testCase "Issue #1584" (do
|
||||
-- This test ensures that we can parse variables with keyword prefixes
|
||||
-- (e.g. `ifX`)
|
||||
_ <- Util.code "./tests/regression/issue1584.dhall"
|
||||
return () )
|
||||
|
||||
parsing0 :: TestTree
|
||||
parsing0 = Test.Tasty.HUnit.testCase "Parsing regression #0" (do
|
||||
-- Verify that parsing should not fail
|
||||
|
|
|
@ -0,0 +1,19 @@
|
|||
[ let ifX = 1 in ifX
|
||||
, let thenX = 1 in thenX
|
||||
, let elseX = 1 in elseX
|
||||
, let letX = 1 in letX
|
||||
, let inX = 1 in inX
|
||||
, let usingX = 1 in usingX
|
||||
{- Fixing this case appears to be difficult for the current parser
|
||||
implementation
|
||||
-}
|
||||
-- , let missingX = 1 in missingX
|
||||
, let asX = 1 in asX
|
||||
, let InfinityX = 1 in InfinityX
|
||||
, let NaNX = 1 in NaNX
|
||||
, let mergeX = 1 in mergeX
|
||||
, let SomeX = 1 in SomeX
|
||||
, let toMapX = 1 in toMapX
|
||||
, let assertX = 1 in assertX
|
||||
, let forallX = 1 in forallX
|
||||
]
|
Loading…
Reference in New Issue