diff --git a/src/Lean/Elab/Syntax.lean b/src/Lean/Elab/Syntax.lean index 9f40c5b178..b088af052e 100644 --- a/src/Lean/Elab/Syntax.lean +++ b/src/Lean/Elab/Syntax.lean @@ -219,7 +219,9 @@ private def declareSyntaxCatQuotParser (catName : Name) : CommandElabM Unit := d @[termParser] def $(mkIdent name) : Lean.ParserDescr := Lean.ParserDescr.node $(quote kind) $(quote Lean.Parser.maxPrec) (Lean.ParserDescr.binary `andthen (Lean.ParserDescr.symbol $(quote quotSymbol)) - (Lean.ParserDescr.binary `andthen (Lean.ParserDescr.cat $(quote catName) 0) (Lean.ParserDescr.symbol ")")))) + (Lean.ParserDescr.binary `andthen + (Lean.ParserDescr.unary `incQuotDepth (Lean.ParserDescr.cat $(quote catName) 0)) + (Lean.ParserDescr.symbol ")")))) elabCommand cmd @[builtinCommandElab syntaxCat] def elabDeclareSyntaxCat : CommandElab := fun stx => do diff --git a/src/Lean/Parser.lean b/src/Lean/Parser.lean index 5e28081ecc..ddb9e777c9 100644 --- a/src/Lean/Parser.lean +++ b/src/Lean/Parser.lean @@ -36,6 +36,7 @@ builtin_initialize registerAlias "interpolatedStr" interpolatedStr registerAlias "orelse" orelse registerAlias "andthen" andthen + registerAlias "incQuotDepth" incQuotDepth end Parser diff --git a/src/Lean/Parser/Basic.lean b/src/Lean/Parser/Basic.lean index b231f5c83a..7f65798c7e 100644 --- a/src/Lean/Parser/Basic.lean +++ b/src/Lean/Parser/Basic.lean @@ -1696,7 +1696,7 @@ def antiquotExpr : Parser := identNoAntiquot <|> antiquotNestedExpr @[inline] def tokenWithAntiquotFn (p : ParserFn) : ParserFn := fun c s => do let s := p c s - if s.hasError then + if s.hasError || c.quotDepth == 0 then return s let iniSz := s.stackSize let iniPos := s.pos @@ -1739,7 +1739,9 @@ def mkAntiquot (name : String) (kind : Option SyntaxNodeKind) (anonymous := true checkNoWsBefore "no space before spliced term" >> antiquotExpr >> nameP -def tryAnti (c : ParserContext) (s : ParserState) : Bool := +def tryAnti (c : ParserContext) (s : ParserState) : Bool := do + if c.quotDepth == 0 then + return false let (s, stx) := peekToken c s match stx with | Except.ok stx@(Syntax.atom _ sym) => sym == "$" @@ -1768,7 +1770,7 @@ def mkAntiquotSplice (kind : SyntaxNodeKind) (p suffix : Parser) : Parser := @[inline] def withAntiquotSuffixSpliceFn (kind : SyntaxNodeKind) (p suffix : ParserFn) : ParserFn := fun c s => do let s := p c s - if s.hasError || !s.stxStack.back.isAntiquot then + if s.hasError || c.quotDepth == 0 || !s.stxStack.back.isAntiquot then return s let iniSz := s.stackSize let iniPos := s.pos @@ -1852,7 +1854,7 @@ def parserOfStack (offset : Nat) (prec : Nat := 0) : Parser := /-- Run `declName` if possible and inside a quotation, or else `p`. The `ParserInfo` will always be taken from `p`. -/ def evalInsideQuot (declName : Name) (p : Parser) : Parser := { p with fn := fun c s => - if c.insideQuot && c.env.contains declName then + if c.quotDepth > 0 && !c.suppressInsideQuot && c.env.contains declName then evalParserConst declName c s else p.fn c s } diff --git a/tests/lean/weirdmacro.lean.expected.out b/tests/lean/weirdmacro.lean.expected.out index ab28885346..7a43439b12 100644 --- a/tests/lean/weirdmacro.lean.expected.out +++ b/tests/lean/weirdmacro.lean.expected.out @@ -1,4 +1,2 @@ weirdmacro.lean:1:6: error: expected no space before ':' or string literal -weirdmacro.lean:1:30-1:32: error: elaboration function for 'antiquot' has not been implemented -weirdmacro.lean:1:32: error: expected command weirdmacro.lean:3:7-3:11: error: unknown identifier 'term'