56 lines
1.8 KiB
Text
56 lines
1.8 KiB
Text
/-
|
|
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
|
Author: Sebastian Ullrich
|
|
|
|
A Combinator for building Pratt parsers
|
|
-/
|
|
prelude
|
|
import init.lean.parser.token
|
|
|
|
namespace Lean.Parser
|
|
open MonadParsec Combinators
|
|
|
|
variables {baseM : Type → Type}
|
|
variables [Monad baseM] [monadBasicParser baseM] [MonadParsec Syntax baseM] [MonadReader ParserConfig baseM]
|
|
|
|
local notation `m` := RecT Nat Syntax baseM
|
|
local notation `Parser` := m Syntax
|
|
|
|
def currLbp : m Nat :=
|
|
do Except.ok tk ← monadLift peekToken | pure 0,
|
|
match tk with
|
|
| Syntax.atom ⟨_, sym⟩ := do
|
|
cfg ← read,
|
|
some ⟨_, tkCfg⟩ ← pure (cfg.tokens.oldMatchPrefix sym.mkOldIterator) | error "currLbp: unreachable",
|
|
pure tkCfg.lbp
|
|
| Syntax.ident _ := pure maxPrec
|
|
| Syntax.rawNode {kind := @number, ..} := pure maxPrec
|
|
| Syntax.rawNode {kind := @stringLit, ..} := pure maxPrec
|
|
| _ := error "currLbp: unknown token kind"
|
|
|
|
private def trailingLoop (trailing : ReaderT Syntax m Syntax) (rbp : Nat) : Nat → Syntax → Parser
|
|
| 0 _ := error "unreachable"
|
|
| (n+1) left := do
|
|
lbp ← currLbp,
|
|
if rbp < lbp then do
|
|
left ← trailing.run left,
|
|
trailingLoop n left
|
|
else
|
|
pure left
|
|
|
|
variables [MonadExcept (Parsec.Message Syntax) baseM] [Alternative baseM]
|
|
variables (leading : m Syntax) (trailing : ReaderT Syntax m Syntax) (p : m Syntax)
|
|
|
|
def prattParser : baseM Syntax :=
|
|
RecT.runParsec p $ λ rbp, do
|
|
left ← leading,
|
|
n ← remaining,
|
|
trailingLoop trailing rbp (n+1) left
|
|
|
|
instance prattParser.tokens [HasTokens leading] [HasTokens trailing] : HasTokens (prattParser leading trailing p) :=
|
|
⟨HasTokens.tokens leading ++ HasTokens.tokens trailing⟩
|
|
instance prattParser.View : HasView Syntax (prattParser leading trailing p) :=
|
|
default _
|
|
|
|
end Lean.Parser
|