diff --git a/library/init/lean/elaborator.lean b/library/init/lean/elaborator.lean index a26819bdc2..5450de2adb 100644 --- a/library/init/lean/elaborator.lean +++ b/library/init/lean/elaborator.lean @@ -19,11 +19,13 @@ open parser.command open parser.command.notation_spec open expander -structure elaborator_config := -(filename : string) +structure elaborator_config extends frontend_config := (local_notations : list notation_macro := []) (initial_parser_cfg : module_parser_config) +instance elaborator_config_coe_frontend_config : has_coe elaborator_config frontend_config := +⟨elaborator_config.to_frontend_config⟩ + structure elaborator_state := -- TODO(Sebastian): retrieve from environment (reserved_notations : list reserve_notation.view := []) @@ -61,11 +63,6 @@ instance elaborator_m_coe_coelaborator_m {α : Type} : has_coe (elaborator_m α) instance elaborator_coe_coelaborator : has_coe elaborator coelaborator := ⟨λ x, do stx ← current_command, x stx⟩ -def error {α : Type} (context : syntax) (text : string) : elaborator_m α := -do cfg ← read, - -- TODO(Sebastian): convert position - throw {filename := cfg.filename, pos := /-context.get_pos.get_or_else-/ ⟨1,0⟩, text := text} - local attribute [instance] name.has_lt_quick def mangle_ident (id : syntax_ident) : name := diff --git a/library/init/lean/expander.lean b/library/init/lean/expander.lean index 0450464cf1..63f3e51bf0 100644 --- a/library/init/lean/expander.lean +++ b/library/init/lean/expander.lean @@ -19,12 +19,15 @@ open parser.combinators open parser.term open parser.command -structure transformer_config := -(filename : string) +structure transformer_config extends frontend_config +-- TODO(Sebastian): the recursion point for `local_expand` probably needs to be stored here + +instance transformer_config_coe_frontend_config : has_coe transformer_config frontend_config := +⟨transformer_config.to_frontend_config⟩ -- TODO(Sebastian): recursive expansion @[derive monad monad_reader monad_except] -def transform_m := reader_t transformer_config $ except_t message id +def transform_m := reader_t frontend_config $ except_t message id abbreviation transformer := syntax → transform_m (option syntax) /-- We allow macros to refuse expansion. This means that nodes can decide whether to act as macros @@ -33,12 +36,12 @@ abbreviation transformer := syntax → transform_m (option syntax) def no_expansion : transform_m (option syntax) := pure none -def error {m : Type → Type} {ρ : Type} [monad m] [monad_reader ρ m] [has_lift_t ρ transformer_config] +def error {m : Type → Type} {ρ : Type} [monad m] [monad_reader ρ m] [has_lift_t ρ frontend_config] [monad_except message m] {α : Type} (context : syntax) (text : string) : m α := do cfg ← read, -- TODO(Sebastian): convert position - throw {filename := transformer_config.filename ↑cfg, pos := /-context.get_pos.get_or_else-/ ⟨1,0⟩, text := text} + throw {filename := frontend_config.filename ↑cfg, pos := /-context.get_pos.get_or_else-/ ⟨1,0⟩, text := text} /-- Coercion useful for introducing macro-local variables. Use `glob_id` to refer to global bindings instead. -/ instance coe_name_ident : has_coe name syntax_ident := diff --git a/library/init/lean/parser/basic.lean b/library/init/lean/parser/basic.lean index b5c063000b..ea5bc1e6dc 100644 --- a/library/init/lean/parser/basic.lean +++ b/library/init/lean/parser/basic.lean @@ -57,11 +57,16 @@ structure parser_cache := -- for profiling (hit miss : nat := 0) -/- Remark: if we have a node in the trie with `some token_config`, the string induced by the path is equal to the `token_config.prefix`. -/ -structure parser_config := -(tokens : trie token_config) +structure frontend_config := (filename : string) +/- Remark: if we have a node in the trie with `some token_config`, the string induced by the path is equal to the `token_config.prefix`. -/ +structure parser_config extends frontend_config := +(tokens : trie token_config) + +instance parser_config_coe : has_coe parser_config frontend_config := +⟨parser_config.to_frontend_config⟩ + @[derive monad alternative monad_parsec monad_except] def parser_core_t (m : Type → Type) [monad m] := parsec_t syntax $ state_t parser_cache $ m @@ -115,12 +120,12 @@ instance has_view.default (r : ρ) : inhabited (parser.has_view syntax r) := class has_view_default (r : ρ) (α : out_param Type) [has_view α r] (default : α) := mk {} -def message_of_parsec_message {μ : Type} (cfg : parser_config) (msg : parsec.message μ) : message := +def message_of_parsec_message {μ : Type} (cfg : frontend_config) (msg : parsec.message μ) : message := -- FIXME: translate position {filename := cfg.filename, pos := ⟨0, 0⟩, text := to_string msg} /-- Run parser stack, returning a partial syntax tree in case of a fatal error -/ -protected def run {m : Type → Type} {α ρ : Type} [monad m] [has_coe_t ρ parser_config] (cfg : ρ) (s : string) (r : state_t parser_state (parser_t ρ m) α) : +protected def run {m : Type → Type} {α ρ : Type} [monad m] [has_coe_t ρ frontend_config] (cfg : ρ) (s : string) (r : state_t parser_state (parser_t ρ m) α) : m (sum α syntax × message_log) := do (r, _) ← (((r.run {messages:=message_log.empty}).run cfg).parse s).run {}, pure $ match r with @@ -133,7 +138,7 @@ open parser.has_view variables {α : Type} {m : Type → Type} local notation `parser` := m syntax -def log_message {μ : Type} [monad m] [monad_reader ρ m] [has_lift_t ρ parser_config] [monad_state parser_state m] +def log_message {μ : Type} [monad m] [monad_reader ρ m] [has_lift_t ρ frontend_config] [monad_state parser_state m] (msg : parsec.message μ) : m unit := do cfg ← read, modify (λ st, {st with messages := st.messages.add (message_of_parsec_message ↑cfg msg)})