147 lines
5.4 KiB
Text
147 lines
5.4 KiB
Text
import init.lean.parser.module init.lean.expander init.lean.elaborator init.io
|
||
open lean
|
||
open lean.parser
|
||
open lean.expander
|
||
open lean.elaborator
|
||
|
||
def check_reprint (p : list module_parser_output) (s : string) : except_t string io unit :=
|
||
do let stx := syntax.list $ p.map (λ o, o.cmd),
|
||
let stx := stx.update_leading s,
|
||
some s' ← pure $ stx.reprint | io.println "reprint fail: choice node",
|
||
when (s ≠ s') (
|
||
io.println "reprint fail:" *>
|
||
io.println s'
|
||
)
|
||
|
||
def show_result (p : list module_parser_output) (s : string) : except_t string io unit :=
|
||
let stx := syntax.list $ p.map (λ r, r.cmd) in
|
||
let stx := stx.update_leading s in
|
||
let msgs := (do r ← p, r.messages.to_list) in
|
||
match msgs with
|
||
| [] := do
|
||
io.println "result:",
|
||
io.println (to_string stx)
|
||
| msgs := do
|
||
msgs.mfor $ λ e, io.println e.text,
|
||
io.println "partial syntax tree:",
|
||
io.println (to_string stx)
|
||
|
||
def mk_config : except string module_parser_config :=
|
||
do t ← parser.mk_token_trie $
|
||
parser.tokens module.parser ++
|
||
parser.tokens command.builtin_command_parsers ++
|
||
parser.tokens term.builtin_leading_parsers ++
|
||
parser.tokens term.builtin_trailing_parsers,
|
||
pure $ {
|
||
filename := "<unknown>", tokens := t,
|
||
command_parsers := command.builtin_command_parsers,
|
||
leading_term_parsers := term.builtin_leading_parsers,
|
||
trailing_term_parsers := term.builtin_trailing_parsers,
|
||
}
|
||
|
||
def parse_module (s : string) : except string (list module_parser_output) :=
|
||
do cfg ← mk_config,
|
||
(outputs, sum.inl (), ⟨[]⟩) ← pure $ coroutine.finish (λ_, cfg)
|
||
(parser.run cfg s (λ st _, module.parser.run st)) cfg
|
||
| except.error "final parser output should be empty!",
|
||
pure outputs
|
||
|
||
def show_parse (s : string) : except_t string io unit :=
|
||
do r ← monad_except.lift_except $ parse_module s,
|
||
check_reprint r s,
|
||
show_result r s
|
||
|
||
#eval show_parse "prelude"
|
||
#eval show_parse "import me"
|
||
#eval show_parse "importme"
|
||
#eval show_parse "import"
|
||
|
||
#eval show_parse "prelude
|
||
import ..a b
|
||
import c"
|
||
|
||
#eval show_parse "open me you"
|
||
#eval show_parse "open me as you (a b c) (renaming a->b c->d) (hiding a b)"
|
||
#eval show_parse "open me you."
|
||
#eval show_parse "open open"
|
||
#eval show_parse "open me import open you"
|
||
|
||
#eval show_parse "open a
|
||
section b
|
||
open c
|
||
section d
|
||
open e
|
||
end d
|
||
end b"
|
||
|
||
-- should not be a parser error
|
||
#eval show_parse "section a end"
|
||
|
||
universes u v
|
||
#check Type max u v -- eh
|
||
-- parsed as `Type (max) (u) (v)`, will fail on elaboration ("max: must have at least two arguments", "function expected at 'Type'", "unknown identifier 'u'/'v'")
|
||
#eval show_parse "#check Type max u v"
|
||
|
||
#eval do
|
||
[header, nota, eoi] ← parse_module "infixl `+`:65 := nat.add" | throw "huh",
|
||
except.ok cmd' ← pure $ (expand nota.cmd).run {filename := "init/core.lean", transformers := builtin_transformers} | throw "heh",
|
||
pure cmd'.reprint
|
||
|
||
-- for structuring the profiler output
|
||
@[noinline] def run_parser {α β : Type} (f : α → β) : α → β := f
|
||
@[noinline] def run_expander {α β : Type} (f : α → β) : α → β := f
|
||
@[noinline] def run_elaborator {α β : Type} (f : α → β) : α → β := f
|
||
|
||
def run_frontend (input : string) : except_t string io unit := do
|
||
parser_cfg ← monad_except.lift_except $ mk_config,
|
||
let expander_cfg : expander_config := {filename := "foo", transformers := builtin_transformers},
|
||
let parser_k := parser.run parser_cfg input (λ st _, module.parser st),
|
||
let elab_k := elaborator.run {filename := "foo", initial_parser_cfg := parser_cfg},
|
||
outs ← io.prim.iterate_eio (parser_k, elab_k, parser_cfg, expander_cfg, ([] : list module_parser_output)) $ λ ⟨parser_k, elab_k, parser_cfg, expander_cfg, outs⟩, match run_parser parser_k.resume parser_cfg with
|
||
| coroutine_result_core.done p := do {
|
||
io.println "parser died!!",
|
||
pure (sum.inr outs.reverse)
|
||
}
|
||
| coroutine_result_core.yielded out parser_k := do {
|
||
match out.messages.to_list with
|
||
| [] := pure () /-do
|
||
io.println "result:",
|
||
io.println (to_string stx)-/
|
||
| msgs := do {
|
||
msgs.mfor $ λ e, io.println e.text/-,
|
||
io.println "partial syntax tree:",
|
||
io.println (to_string out.cmd)-/
|
||
},
|
||
--io.println out.cmd,
|
||
match run_expander (expand out.cmd).run expander_cfg with
|
||
| except.ok cmd' := do {
|
||
--io.println cmd',
|
||
match run_elaborator elab_k.resume cmd' with
|
||
| coroutine_result_core.done msgs := do {
|
||
when ¬(cmd'.is_of_kind module.eoi) $
|
||
io.println "elaborator died!!",
|
||
msgs.to_list.mfor $ λ e, io.println e.text,
|
||
io.println $ "parser cache hit rate: " ++ to_string out.cache.hit ++ "/" ++
|
||
to_string (out.cache.hit + out.cache.miss),
|
||
pure $ sum.inr (out::outs).reverse
|
||
}
|
||
| coroutine_result_core.yielded elab_out elab_k := do {
|
||
elab_out.messages.to_list.mfor $ λ e, io.println e.text,
|
||
pure (sum.inl (parser_k, elab_k, elab_out.parser_cfg, elab_out.expander_cfg, out :: outs))
|
||
}
|
||
}
|
||
| except.error e := io.println e.text *> pure (sum.inl (parser_k, elab_k, parser_cfg, expander_cfg, out :: outs))
|
||
},
|
||
check_reprint outs input/-,
|
||
let stx := syntax.node ⟨none, outs.map (λ r, r.cmd)⟩,
|
||
let stx := stx.update_leading input,
|
||
io.println "result:",
|
||
io.println (to_string stx)-/
|
||
#exit
|
||
|
||
-- slowly progressing...
|
||
set_option profiler true
|
||
#eval do
|
||
s ← io.fs.read_file "../../library/init/core.lean",
|
||
--let s := (s.mk_iterator.nextn 10000).prev_to_string,
|
||
run_frontend s
|