feat(library/init/lean/parser/reader/module): command-level error recovery

library/init/lean/parser/parsec.lean

@@ -215,6 +215,11 @@ lift $ λ it', result.error { unexpected := unexpected, expected := expected, it
 def left_over : m iterator :=
 lift $ λ it, result.mk_eps it it
 
+/-- Replace the input iterator. This is usually used to change the parser
+    position inside the same input string. -/
+def set_iterator (it : iterator) : m unit :=
+lift $ λ _, result.ok () it
+
 /-- Return the number of characters left to be parsed. -/
 def remaining : m nat :=
 string.iterator.remaining <$> left_over

library/init/lean/parser/reader/module.lean

@@ -6,11 +6,11 @@ Author: Sebastian Ullrich
 Module-level readers and macros
 -/
 prelude
-import init.lean.parser.reader.token init.lean.parser.reader.term
+import init.lean.parser.reader.token init.lean.parser.reader.term init.data.list.instances
 
 namespace lean.parser
 namespace reader
-open combinators
+open combinators monad_parsec
 
 def symbol_coe : has_coe string reader := ⟨symbol⟩
 def seq_coe : has_coe_t (list reader) reader := ⟨seq⟩
@@ -64,7 +64,7 @@ def «notation» := {macro . name := `notation}
 def prec : reader := [":", number]/-TODO <|> expr-/
 
 def quoted_symbol : read_m syntax :=
-do (s, info) ← with_source_info $ monad_parsec.take_until (= '`'),
+do (s, info) ← with_source_info $ take_until (= '`'),
    pure $ syntax.atom ⟨info, atomic_val.string s⟩
 
 def notation_tk :=
@@ -104,12 +104,42 @@ node «notation» ["notation", notation_reader, ":=", term.reader]
 
 def command.reader :=
 with_recurse $ any_of [open.reader, section.reader, notation.reader] <?> "command"
+
+/-- Read commands, recovering from errors inside commands (attach partial syntax tree)
+    as well as unknown commands (skip input). -/
+private def commands_aux : bool → list syntax → nat → read_m syntax
+| recovering cs 0            := error "unreachable"
+-- on end of input, return list of parsed commands
+| recovering cs (nat.succ n) := (eoi *> pure (syntax.node ⟨name.anonymous, cs.reverse⟩)) <|> do
+  (recovering, c) ← catch (do {
+    c ← command.reader.read,
+    pure (ff, some c)
+  } <|> do {
+      -- unknown command: try to skip token, or else single character
+      when (¬ recovering) $ do {
+        it ← left_over,
+        log_error $ to_string { parsec.message . expected := dlist.singleton "command", it := it, custom := () }
+      },
+      catch (token *> pure ()) (λ _,  any *> pure ()),
+      pure (tt, none)
+    }) $ λ msg, do {
+      -- error inside command: advance input to error position, log error, return partial syntax tree
+      set_iterator msg.it,
+      modify (λ st, {st with errors := to_string msg :: st.errors}),
+      pure (tt, some msg.custom)
+    },
+  commands_aux recovering (c.to_monad++cs) n
+
+def commands.reader : reader :=
+{ read := do { rem ← remaining, commands_aux ff [] rem.succ },
+  tokens := command.reader.tokens }
+
 end commands
 
 def module := {macro . name := `module}
 
 def module.reader : reader :=
-node module [prelude.reader?, import.reader*, command.reader*]
+node module [prelude.reader?, import.reader*, commands.reader]
 
 end reader
 end lean.parser

tests/lean/reader1.lean

@@ -41,4 +41,4 @@ end b"
 -- slowly progressing...
 #eval do
   s ← io.fs.read_file "../../library/init/core.lean",
-  show_result module.reader s
+  show_result module.reader $ (s.mk_iterator.nextn 300).prev_to_string

tests/lean/reader1.lean.expected.out

@@ -3,7 +3,7 @@ result:
 result: 
 (module [] [(import "import" [(import_path [] me)])] [])
 error at line 1, column 0:
-expected end of input
+expected command
 partial syntax tree:
 (module [] [] [])
 result: 
@@ -26,7 +26,7 @@ result:
      [[["(" "renaming"] [[a "->" b] [c "->" d]] ")"]]
      [["(" "hiding" [a b] ")"]]]])])
 error at line 1, column 8:
-expected end of input
+expected command
 partial syntax tree:
 (module [] [] [(open "open" [[me [] [] [] []]])])
 result: 
@@ -48,7 +48,17 @@ result:
  []
  []
  [(notation "notation" [[] [[["`" "Prop" "`" []] []]]] ":=" (hole "_"))])
-error at line 10, column 0:
-expected end of input
+error at line 10, column 19:
+expected "_"
+error at line 11, column 26:
+expected "_"
 partial syntax tree:
-(module [(prelude "prelude")] [] [])
+(module
+ [(prelude "prelude")]
+ []
+ [(notation "notation" [[] [[["`" "Prop" "`" []] []]]] ":=" (hole []))
+  (notation
+   "notation"
+   [[f] [[["`" "$ " "`" [[":" (base10_lit "1")]]] [[a [[":" (base10_lit "0")]]]]]]]
+   ":="
+   (hole []))])