diff --git a/doc/UsersGuide/Markup.lean b/doc/UsersGuide/Markup.lean index af6ab13f6..023068077 100644 --- a/doc/UsersGuide/Markup.lean +++ b/doc/UsersGuide/Markup.lean @@ -291,7 +291,9 @@ def markupPreview : DirectiveExpanderOf MarkupPreviewConfig let `(block|``` | $expected ```) := blk2 | throwErrorAt blk1 "Expected anonymous code block" - let stx ← blocks {} |>.parseString contents.getString.trimAsciiEnd.copy +-- XXX Fixme due to trimAsciiEnd +-- let stx ← blocks {} |>.parseString contents.getString.trimAsciiEnd.copy + let stx ← blocks {} |>.parseString contents (versoStyle := true) let p ← preview stx let p := p.pretty (width := 35) @@ -327,7 +329,7 @@ open Verso.Parser in def markupPreviewPre : CodeBlockExpanderOf MarkupPreviewConfig | {title}, contents => do - let stx ← blocks {} |>.parseString contents.getString + let stx ← blocks {} |>.parseString contents (versoStyle := true) let p ← preview stx let p := p.pretty (width := 35) @@ -430,7 +432,7 @@ Metadata blocks begin and end with `%%%`, and they contain any syntax that would a b c ``` ``` -

a b c

+

a b c

``` ::: @@ -690,7 +692,7 @@ A description item is a line that starts with zero or more spaces, followed by a
Item 2
-

Description of item 2

+

Description of item 2

``` @@ -729,7 +731,7 @@ But not this one.

So is this one.

-

But not this one.

+

But not this one.

``` ::: @@ -941,6 +943,7 @@ Hyperlinks consist of the link text in square brackets followed by the target in Lean +

``` ::: @@ -987,7 +990,9 @@ This makes it possible to represent values that begin or end with back-ticks: `` `quotedName `` ``` ``` -

"`quotedName"

+

+ "`quotedName" +

``` ::: or with spaces: @@ -996,7 +1001,9 @@ or with spaces: `` one space `` ``` ``` -

" one space "

+

+ " one space " +

``` ::: @@ -1011,6 +1018,7 @@ Images require both alternative text and an address for the image: Alt text +

``` ::: @@ -1057,6 +1065,7 @@ $`\frac{1}{2}`-powered syntax] -powered syntax +

``` ::: @@ -1071,6 +1080,7 @@ This one takes a single inline code element without needing square brackets: "2 + f 4" +

``` ::: diff --git a/src/verso-blog/VersoBlog.lean b/src/verso-blog/VersoBlog.lean index 83fbfb7ce..6b69a66df 100644 --- a/src/verso-blog/VersoBlog.lean +++ b/src/verso-blog/VersoBlog.lean @@ -29,7 +29,7 @@ namespace Verso.Genre.Blog open Lean.Doc.Syntax open Verso ArgParse Doc Elab open Lean Elab -open Verso.SyntaxUtils (parserInputString strLitInputContext) +open Verso.SyntaxUtils (inputContextFromStrLit strLitInputContext) open SubVerso.Examples (loadExamples Example) open SubVerso.Examples.Messages (messagesMatch) @@ -196,7 +196,7 @@ where section inductive LeanExampleData where - | inline (commandState : Command.State) (parserState : Parser.ModuleParserState) + | inline (commandState : Command.State) | subproject (loaded : NameSuffixMap Example) | module (positioned : Array ModuleItem) deriving Inhabited @@ -434,9 +434,32 @@ instance [Monad m] [MonadInfoTree m] [MonadLiftT CoreM m] [MonadEnv m] [MonadErr .flag `showProofStates true "Show proof states in rendered page?" +def parserInputString [Monad m] [MonadFileMap m] + (str : TSyntax `str) : + m String := do + let text ← getFileMap + let preString := (0 : String.Pos.Raw).extract text.source (str.raw.getPos?.getD 0) + let mut code := "" + let mut iter := preString.startPos + while h : iter ≠ preString.endPos do + let c := iter.get h + iter := iter.next h + if c == '\n' then + code := code.push '\n' + else + for _ in [0:c.utf8Size] do + code := code.push ' ' + let strOriginal? : Option String := do + let ⟨start, stop⟩ ← str.raw.getRange? + start.extract text.source stop + code := code ++ strOriginal?.getD str.getString + return code + @[code_block] def leanInit : CodeBlockExpanderOf LeanInitBlockConfig | config , str => withTraceNode `Elab.Verso.block.lean (fun _ => pure m!"leanInit") <| do + -- XXX [upstream]: can't use pos here due to `Parser.parseHeader` type + let (_pos, _context) ← inputContextFromStrLit str let context := Parser.mkInputContext (← parserInputString str) (← getFileName) let (header, state, msgs) ← Parser.parseHeader context if !header.raw[0].isNone then @@ -447,7 +470,7 @@ def leanInit : CodeBlockExpanderOf LeanInitBlockConfig if header.raw[1].isNone then -- if the "prelude" option was not set, use the current env let commandState := configureCommandState (← getEnv) {} let commandState := { commandState with scopes := [{ header := "", opts := pp.tagAppFns.set {} true }] } - modifyEnv <| fun env => exampleContextExt.modifyState env fun s => {s with contexts := s.contexts.insert config.exampleContext.getId (.inline commandState state)} + modifyEnv <| fun env => exampleContextExt.modifyState env fun s => {s with contexts := s.contexts.insert config.exampleContext.getId (.inline commandState)} else if header.raw[2].getArgs.isEmpty then let (env, msgs) ← processHeader header opts msgs context 0 @@ -457,7 +480,7 @@ def leanInit : CodeBlockExpanderOf LeanInitBlockConfig liftM (m := IO) (throw <| IO.userError "Errors during import; aborting") let commandState := configureCommandState env {} let commandState := { commandState with scopes := [{ header := "", opts := pp.tagAppFns.set {} true }] } - modifyEnv <| fun env => exampleContextExt.modifyState env fun s => {s with contexts := s.contexts.insert config.exampleContext.getId (.inline commandState state)} + modifyEnv <| fun env => exampleContextExt.modifyState env fun s => {s with contexts := s.contexts.insert config.exampleContext.getId (.inline commandState)} if config.show then ``(Block.code $(quote str.getString)) -- TODO highlighting hack else @@ -471,16 +494,17 @@ open SubVerso.Highlighting Highlighted in def lean : CodeBlockExpanderOf LeanBlockConfig | config, str => withTraceNode `Elab.Verso.block.lean (fun _ => pure m!"lean block") <| withoutAsync do let x := config.exampleContext - let (commandState, state) ← match exampleContextExt.getState (← getEnv) |>.contexts.find? x.getId with - | some (.inline commandState state) => pure (commandState, state) + let commandState ← match exampleContextExt.getState (← getEnv) |>.contexts.find? x.getId with + | some (.inline commandState) => pure (commandState) | some (.subproject ..) => throwErrorAt x "Expected an example context for inline Lean, but found a subproject" | some (.module ..) => throwErrorAt x "Expected an example context for inline Lean, but found a module" | none => throwErrorAt x "Can't find example context" let (context, startPos) ← strLitInputContext str.raw (← getFileName) + let state := { pos := startPos } -- Process with empty messages to avoid duplicate output let s ← withTraceNode `Elab.Verso.block.lean (fun _ => pure m!"Elaborating commands") <| - IO.processCommands context { state with pos := startPos } { commandState with messages.unreported := {} } + IO.processCommands context state { commandState with messages.unreported := {} } for t in s.commandState.infoState.trees do pushInfoTree t @@ -501,7 +525,7 @@ def lean : CodeBlockExpanderOf LeanBlockConfig if config.keep && !config.error then modifyEnv fun env => exampleContextExt.modifyState env fun st => {st with - contexts := st.contexts.insert x.getId (.inline {s.commandState with messages := {} } s.parserState) + contexts := st.contexts.insert x.getId (.inline {s.commandState with messages := {} }) } if let some infoName := config.name then modifyEnv fun env => messageContextExt.modifyState env fun st => {st with @@ -606,8 +630,8 @@ private def leanInlineImpl : RoleExpanderOf LeanInlineConfig let `(inline|code( $str:str )) := code | throwErrorAt code "Expected an inline code element" let x := config.exampleContext - let (commandState, _) ← match exampleContextExt.getState (← getEnv) |>.contexts.find? x.getId with - | some (.inline commandState state) => pure (commandState, state) + let commandState ← match exampleContextExt.getState (← getEnv) |>.contexts.find? x.getId with + | some (.inline commandState) => pure commandState | some (.subproject ..) => throwErrorAt x "Expected an example context for inline Lean, but found a subproject" | some (.module ..) => throwErrorAt x "Expected an example context for inline Lean, but found a module" | none => throwErrorAt x "Can't find example context" @@ -615,9 +639,6 @@ private def leanInlineImpl : RoleExpanderOf LeanInlineConfig let {env, scopes, ngen, ..} := commandState let {openDecls, currNamespace, opts, ..} := scopes.head! - - let altStr ← parserInputString str - let leveller {α} : TermElabM α → TermElabM α := if let some us := config.universes then let us := @@ -626,7 +647,7 @@ private def leanInlineImpl : RoleExpanderOf LeanInlineConfig Elab.Term.withLevelNames us else id - match Parser.runParserCategory env `term altStr (← getFileName) with + match (← SyntaxUtils.runParserCategory `term str) with | .error e => throwErrorAt str e | .ok stx => withOptions (fun _ => opts) <| runWithOpenDecls scopes <| runWithVariables scopes fun _ => do let (newMsgs, type, tree) ← do @@ -636,7 +657,7 @@ private def leanInlineImpl : RoleExpanderOf LeanInlineConfig let (tree', t) ← do let expectedType ← config.type.mapM fun (s : StrLit) => do - match Parser.runParserCategory env `term s.getString (← getFileName) with + match (← SyntaxUtils.runParserCategory `term s) with | .error e => throwErrorAt str e | .ok stx => withEnableInfoTree false do let t ← leveller <| Elab.Term.elabType stx diff --git a/src/verso-manual/VersoManual/Imports.lean b/src/verso-manual/VersoManual/Imports.lean index ff6ced63b..05aba97bc 100644 --- a/src/verso-manual/VersoManual/Imports.lean +++ b/src/verso-manual/VersoManual/Imports.lean @@ -32,7 +32,8 @@ Parses, but does not validate, a module header. def imports : CodeBlockExpanderOf ImportsParams | { «show» } , str => do let p := Parser.whitespace >> Parser.Module.header.fn - let headerStx ← parseStrLitWith p str + -- Provenance of `str` here is from Verso parser + let headerStx ← p.parseString str (versoStyle := true) let hl ← highlight headerStx #[] {} if «show» then ``(Block.other (Block.lean $(quote hl) {}) #[Block.code $(quote str.getString)]) diff --git a/src/verso-manual/VersoManual/InlineLean.lean b/src/verso-manual/VersoManual/InlineLean.lean index ac367ccdb..b256edf93 100644 --- a/src/verso-manual/VersoManual/InlineLean.lean +++ b/src/verso-manual/VersoManual/InlineLean.lean @@ -28,7 +28,7 @@ open Verso ArgParse Doc Elab Genre.Manual Html Code Highlighted.WebAssets Expect open Lean Elab open SubVerso.Highlighting -open Verso.SyntaxUtils (runParserCategory' SyntaxError parseStrLitAsCategory strLitInputContext) +open Verso.SyntaxUtils (SyntaxError parseStrLitAsCategory strLitInputContext) open Lean.Doc.Syntax open Lean.Elab.Tactic.GuardMsgs @@ -392,15 +392,15 @@ def leanTerm : CodeBlockExpanderOf LeanInlineConfig Core.resetMessageLog let tree' ← runWithOpenDecls <| runWithVariables fun _vars => do - let expectedType ← config.type.mapM fun (s : StrLit) => do - match Parser.runParserCategory (← getEnv) `term s.getString (← getFileName) with + let expectedType ← config.type.mapM fun (str : StrLit) => do + match (← SyntaxUtils.runParserCategory `term str) with | .error e => throwErrorAt stx e | .ok stx => withEnableInfoTree false do let t ← leveller <| Elab.Term.elabType stx Term.synthesizeSyntheticMVarsNoPostponing let t ← instantiateMVars t if t.hasExprMVar || t.hasLevelMVar then - throwErrorAt s "Type contains metavariables: {t}" + throwErrorAt str "Type contains metavariables: {t}" pure t let e ← Elab.Term.elabTerm (catchExPostpone := true) stx expectedType @@ -469,15 +469,15 @@ def leanInline : RoleExpanderOf LeanInlineConfig Core.resetMessageLog let (tree', t) ← runWithOpenDecls <| runWithVariables fun _ => do - let expectedType ← config.type.mapM fun (s : StrLit) => do - match Parser.runParserCategory (← getEnv) `term s.getString (← getFileName) with + let expectedType ← config.type.mapM fun (str : StrLit) => do + match (← SyntaxUtils.runParserCategory `term str) with | .error e => throwErrorAt term e | .ok stx => withEnableInfoTree false do let t ← leveller <| Elab.Term.elabType stx Term.synthesizeSyntheticMVarsNoPostponing let t ← instantiateMVars t if t.hasExprMVar || t.hasLevelMVar then - throwErrorAt s "Type contains metavariables: {t}" + throwErrorAt str "Type contains metavariables: {t}" pure t let e ← leveller <| Elab.Term.elabTerm (catchExPostpone := true) stx expectedType diff --git a/src/verso-manual/VersoManual/InlineLean/SyntaxError.lean b/src/verso-manual/VersoManual/InlineLean/SyntaxError.lean index 73c57c6de..9cc4d3a8c 100644 --- a/src/verso-manual/VersoManual/InlineLean/SyntaxError.lean +++ b/src/verso-manual/VersoManual/InlineLean/SyntaxError.lean @@ -16,7 +16,7 @@ open SubVerso.Highlighting open Verso Genre Manual ArgParse Doc Elab open Verso Output Html open Verso Code Highlighted WebAssets -open Verso.SyntaxUtils +open Verso.SyntaxUtils (SyntaxError) open Lean Elab namespace Verso.Genre.Manual.InlineLean @@ -139,8 +139,8 @@ def syntaxError : CodeBlockExpanderOf SyntaxErrorConfig (kind := Lsp.SymbolKind.file) (detail? := some "Syntax error") - let s := str.getString - match runParserCategory' (← getEnv) (← getOptions) config.category s with + let errorFn := SyntaxUtils.runParserCategory.toSyntaxErrors + match (← SyntaxUtils.runParserCategoryGen (errorFn := errorFn) config.category str) with | .ok stx => throwErrorAt str m!"Expected a syntax error for category {config.category}, but got {indentD stx}" | .error es => @@ -150,6 +150,7 @@ def syntaxError : CodeBlockExpanderOf SyntaxErrorConfig saveOutputs config.name msgs Hover.addCustomHover (← getRef) <| MessageData.joinSep (msgs.map fun ⟨sev, msg⟩ => m!"{sevStr sev.toSeverity}:{indentD msg.toString}") Format.line + let s := str.getString `(Block.other {Block.syntaxError with data := ToJson.toJson ($(quote s), $(quote es))} #[Block.code $(quote s)]) where sevStr : MessageSeverity → String diff --git a/src/verso/Verso/Parser.lean b/src/verso/Verso/Parser.lean index 1b6365461..fcf9d0551 100644 --- a/src/verso/Verso/Parser.lean +++ b/src/verso/Verso/Parser.lean @@ -985,13 +985,15 @@ namespace Verso.Doc.Concrete open Verso.Parser open Lean Elab Term -public def stringToInlines [Monad m] [MonadError m] [MonadEnv m] [MonadQuotation m] (s : StrLit) : m (Array Syntax) := +-- Important! Both functions below expect strings in "Lean style", +-- that is to say, with positions including quotes around the string. +public def stringToInlines [Monad m] [MonadError m] [MonadLog m] [MonadOptions m] [MonadEnv m] [MonadQuotation m] (s : StrLit) : m (Array Syntax) := withRef s do - return (← textLine.parseString s.getString).getArgs + return (← textLine.parseString s).getArgs open Lean Elab Term in -public def stringToBlocks [Monad m] [MonadError m] [MonadEnv m] [MonadQuotation m] (s : StrLit) : m (Array Syntax) := +public def stringToBlocks [Monad m] [MonadError m] [MonadLog m] [MonadOptions m] [MonadEnv m] [MonadQuotation m] (s : StrLit) : m (Array Syntax) := withRef s do - return (← (blocks {}).parseString s.getString).getArgs + return (← (blocks {}).parseString s).getArgs end Verso.Doc.Concrete diff --git a/src/verso/Verso/SyntaxUtils.lean b/src/verso/Verso/SyntaxUtils.lean index 72cde7b02..691108898 100644 --- a/src/verso/Verso/SyntaxUtils.lean +++ b/src/verso/Verso/SyntaxUtils.lean @@ -134,6 +134,24 @@ macro_rules | `( ` ) => ``(Syntax.atom _ $e) end +open Syntax in + +/-- Get the inner start/end position of a string literal. + +If the string is coming from Verso, these are the positions stored in the syntax object. Otherwise, +the positions include the surrounding quotes and need to be adjusted. +-/ +def _root_.Lean.TSyntax.innerPos? (str : StrLit) (versoStyle : Bool) : Option (String.Pos.Raw × String.Pos.Raw) := + if versoStyle then + match str.raw.getPos?, str.raw.getTailPos? with + | (some pos), (some endPos) => some (pos, endPos) + | _, _ => none + else + -- TODO: handle raw string literals, e.g. r###"foo"###. + str.raw.getPos? |>.map fun pos => + let startPos := pos.increaseBy 1 + (startPos, startPos.increaseBy str.getString.utf8ByteSize) + /-- Returns an `InputContext` and start position for parsing the contents of a string literal that was part of the original source file. @@ -151,31 +169,23 @@ public def strLitInputContext [Monad m] [MonadFileMap m] [MonadError m] (str : S let ictx := Parser.mkInputContext text.source fileName (endPos := endPos) (endPos_valid := by grind) return (ictx, startPos) -/-- -Given a string literal, constructs a Lean string that can be parsed by the Lean parser, yielding -correct source positions for items in the string literal. --/ -public def parserInputString [Monad m] [MonadFileMap m] - (str : TSyntax `str) : - m String := do - let text ← getFileMap - let preString := (0 : String.Pos.Raw).extract text.source (str.raw.getPos?.getD 0) - let mut code := "" - let mut iter := preString.startPos - while h : iter ≠ preString.endPos do - let c := iter.get h - iter := iter.next h - if c == '\n' then - code := code.push '\n' - else - for _ in [0:c.utf8Size] do - code := code.push ' ' - let strOriginal? : Option String := do - let ⟨start, stop⟩ ← str.raw.getRange? - start.extract text.source stop - code := code ++ strOriginal?.getD str.getString - return code - +/-- Compute a parsing starting position and `InputContext` from an + embedded string literal. This is often used to call Lean's parser + re-entranly. **Precondition**: the string literal must appear in the + source, otherwise the function may panic. -/ +public def inputContextFromStrLit [Monad m] [MonadLog m] [MonadFileMap m] (str : StrLit) (versoStyle : Bool := true) (fileName : Option String := none) : m (String.Pos.Raw × InputContext) := do + -- dbg_trace "{repr str}" + let filename ← fileName.getDM getFileName + let source := (← getFileMap).source + let some (pos, endPos) := str.innerPos? versoStyle + -- XXX: replace by elaborator exception (throwErrorAt) + -- XXX: Gonna fail when users write a bad macro + | panic "invalid string literal on parser resumption (inputContextFromStrLit)" + if endPos_valid : endPos ≤ source.rawEndPos then + let iCtx := mkInputContext source filename (endPos := endPos) (endPos_valid := endPos_valid) + return (pos, iCtx) + else + panic "invalid source code slice on parser resumption, slice goes out of bounds" public structure SyntaxError where pos : Position @@ -183,10 +193,7 @@ public structure SyntaxError where text : String deriving ToJson, FromJson, BEq, Repr, Quote - - -- Based on mkErrorMessage used in Lean upstream - keep them in synch for best UX -open Lean.Parser in private partial def mkSyntaxError (c : InputContext) (pos : String.Pos.Raw) (stk : SyntaxStack) (e : Parser.Error) : SyntaxError := Id.run do let mut pos := pos let mut endPos? := none @@ -218,18 +225,21 @@ where if let .original (trailing := trailing) .. := stx.getTailInfo then pure (some trailing) else none -public defmethod ParserFn.parseString [Monad m] [MonadError m] [MonadEnv m] (p : ParserFn) (input : String) : m Syntax := do - let ictx := mkInputContext input "" +-- This parses a regular Lean string, that is to say, positions include the outer quotes +public defmethod ParserFn.parseString [Monad m] [MonadLog m] [MonadOptions m] [MonadError m] [MonadEnv m] (p : ParserFn) (input : StrLit) (versoStyle : Bool := false): m Syntax := do + let (pos, iCtx) ← inputContextFromStrLit input versoStyle let env ← getEnv - let pmctx : ParserModuleContext := {env := env, options := {}} - let s' := p.run ictx pmctx (getTokenTable env) (mkParserState input) + let options ← getOptions + let pmctx : ParserModuleContext := {env, options} + let pst := { mkParserState iCtx.inputString with pos } + let s' := p.run iCtx pmctx (getTokenTable env) pst let stk := s'.stxStack.extract 0 s'.stxStack.size if let some err := s'.errorMsg then throwError err.toString if s'.recoveredErrors.size > 0 then throwError String.intercalate "\n" <| Std.HashSet.toList <| Std.HashSet.ofArray <| s'.recoveredErrors.map fun (p, s, e) => - let err := mkSyntaxError ictx p s e + let err := mkSyntaxError iCtx p s e err.text if h : stk.size ≠ 1 then throwError "Expected single item in parser stack, got {ppStack stk}" @@ -270,48 +280,51 @@ actual string contents. public def parseStrLitAsCategory [Monad m] [MonadLog m] [MonadEnv m] [MonadOptions m] [MonadError m] [AddMessageContext m] (catName : Name) (input : StrLit) : m Syntax := parseStrLitWith (andthenFn whitespace (categoryParserFnImpl catName)) input -open Lean.Parser in -/-- -Runs a parser category, returning any errors encountered as a list of position-string pairs. +-- Default from upstream +public def runParserCategory.toErrorMsg (ictx : InputContext) (s : ParserState) := + s.toErrorMsg ictx + +-- Unused +public def runParserCategory.toErrorMsgList (ictx : InputContext) (s : ParserState) : List (Position × String) := Id.run do + let mut errs := [] + for (pos, _stk, err) in s.allErrors do + let pos := ictx.fileMap.toPosition pos + errs := (pos, toString err) :: errs + errs.reverse + +-- Used in Manual's syntaxError block +public def runParserCategory.toSyntaxErrors (ictx : InputContext) (s : ParserState) : Array SyntaxError := + s.allErrors.map fun (pos, stk, e) => (mkSyntaxError ictx pos stk e) + +/-- Runs a parser category, returning any errors encountered. It takes +and optional `fileName` as callers in VersoManual/Docstring like to +override it. This expects a Verso String Literal, that is to say, positions don't include the quotes. -/ -public def runParserCategory - (env : Environment) (opts : Lean.Options) (catName : Name) - (input : String) (fileName : String := "") : - Except (List (Position × String)) Syntax := +public def runParserCategoryGen [Monad m] [MonadEnv m] [MonadLog m] [MonadOptions m] + (errorFn : InputContext → ParserState → ε) + (catName : Name) (input : StrLit) (versoStyle : Bool := true) (fileName : Option String := none) : m (Except ε Syntax) := do + let env ← getEnv + let options ← getOptions let p := andthenFn whitespace (categoryParserFnImpl catName) - let ictx := mkInputContext input fileName - let s := p.run ictx { env, options := opts } (getTokenTable env) (mkParserState input) - if !s.allErrors.isEmpty then - Except.error (toErrorMsg ictx s) + let (pos, ictx) ← inputContextFromStrLit input versoStyle fileName + let pst := { mkParserState ictx.inputString with pos } + let s := p.run ictx { env, options } (getTokenTable env) pst + pure $ if !s.allErrors.isEmpty then + Except.error (errorFn ictx s) else if ictx.atEnd s.pos then Except.ok s.stxStack.back else - Except.error (toErrorMsg ictx (s.mkError "end of input")) -where - toErrorMsg (ctx : InputContext) (s : ParserState) : List (Position × String) := Id.run do - let mut errs := [] - for (pos, _stk, err) in s.allErrors do - let pos := ctx.fileMap.toPosition pos - errs := (pos, toString err) :: errs - errs.reverse - -open Lean.Parser in -/-- -Runs a parser category, returning any errors encountered as `SyntaxError`s, with the source spans -computed the way Lean does. --/ -public def runParserCategory' (env : Environment) (opts : Lean.Options) (catName : Name) (input : String) (fileName : String := "") : Except (Array SyntaxError) Syntax := - let p := andthenFn whitespace (categoryParserFnImpl catName) - let ictx := mkInputContext input fileName - let s := p.run ictx { env, options := opts } (getTokenTable env) (mkParserState input) - if !s.allErrors.isEmpty then - Except.error <| toSyntaxErrors ictx s - else if ictx.atEnd s.pos then - Except.ok s.stxStack.back - else - Except.error (toSyntaxErrors ictx (s.mkError "end of input")) -where - toSyntaxErrors (ictx : InputContext) (s : ParserState) : Array SyntaxError := - s.allErrors.map fun (pos, stk, e) => (mkSyntaxError ictx pos stk e) + Except.error (errorFn ictx (s.mkError "end of input")) + +public def runParserCategory [Monad m] [MonadEnv m] [MonadLog m] [MonadOptions m] + (catName : Name) (input : StrLit) (versoStyle : Bool := true) (fileName : Option String := none) : m (Except String Syntax) := + runParserCategoryGen runParserCategory.toErrorMsg catName input versoStyle fileName + +/- This function can be used to check whether string are in Verso + style or in Lean style -/ +public def checkString (str : StrLit) : String := + let s := str.getString + let sz := (str.raw.getTailPos?.getD 0 |>.byteIdx) - str.raw.getPos!.byteIdx + s!"real size: {s.length}, syntax size: {sz}" end Verso.SyntaxUtils