diff --git a/library/init/meta/expr.lean b/library/init/meta/expr.lean index 33e1768af2..dbf05eb021 100644 --- a/library/init/meta/expr.lean +++ b/library/init/meta/expr.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ prelude -import init.meta.level init.category.monad +import init.meta.level init.category.monad init.meta.rb_map universes u v structure pos := @@ -128,6 +128,8 @@ meta constant expr.collect_univ_params : expr → list name /-- `occurs e t` returns `tt` iff `e` occurs in `t` -/ meta constant expr.occurs : expr → expr → bool +meta constant expr.has_local_in : expr → name_set → bool + /-- (reflected a) is a special opaque container for a closed `expr` representing `a`. It can only be obtained via type class inference, which will use the representation of `a` in the calling context. Local constants in the representation are replaced @@ -391,3 +393,16 @@ meta def mfold {α : Type} {m : Type → Type} [monad m] (e : expr) (a : α) (fn fold e (return a) (λ e n a, a >>= fn e n) end expr + +@[reducible] meta def expr_map (data : Type) := rb_map expr data +namespace expr_map +export rb_map (hiding mk) + +meta def mk (data : Type) : expr_map data := rb_map.mk expr data +end expr_map + +meta def mk_expr_map {data : Type} : expr_map data := +expr_map.mk data + +@[reducible] meta def expr_set := rb_set expr +meta def mk_expr_set : expr_set := mk_rb_set diff --git a/library/init/meta/rb_map.lean b/library/init/meta/rb_map.lean index be7f84df26..224d25431b 100644 --- a/library/init/meta/rb_map.lean +++ b/library/init/meta/rb_map.lean @@ -4,13 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad -/ prelude -import init.data.ordering init.function init.meta.name init.meta.format init.meta.expr +import init.data.ordering init.function init.meta.name init.meta.format init.category.monad meta constant {u₁ u₂} rb_map : Type u₁ → Type u₂ → Type (max u₁ u₂) namespace rb_map meta constant mk_core {key : Type} (data : Type) : (key → key → ordering) → rb_map key data meta constant size {key : Type} {data : Type} : rb_map key data → nat +meta constant empty {key : Type} {data : Type} : rb_map key data → bool meta constant insert {key : Type} {data : Type} : rb_map key data → key → data → rb_map key data meta constant erase {key : Type} {data : Type} : rb_map key data → key → rb_map key data meta constant contains {key : Type} {data : Type} : rb_map key data → key → bool @@ -78,16 +79,6 @@ end name_map meta def mk_name_map {data : Type} : name_map data := name_map.mk data -@[reducible] meta def expr_map (data : Type) := rb_map expr data -namespace expr_map -export rb_map (hiding mk) - -meta def mk (data : Type) : expr_map data := rb_map.mk expr data -end expr_map - -meta def mk_expr_map {data : Type} : expr_map data := -expr_map.mk data - open rb_map prod section open format @@ -162,6 +153,9 @@ s.contains k meta def size {key} (s : rb_set key) : nat := s.size +meta def empty {key : Type} (s : rb_set key) : bool := +s.empty + meta def fold {key α : Type} (s : rb_set key) (a : α) (fn : key → α → α) : α := s.fold a (λ k _ a, fn k a) @@ -176,9 +170,6 @@ meta instance {key} [has_to_format key] : has_to_format (rb_set key) := to_fmt "}"⟩ end rb_set -@[reducible] meta def expr_set := rb_set expr -meta def mk_expr_set : expr_set := mk_rb_set - meta constant name_set : Type meta constant mk_name_set : name_set @@ -187,6 +178,7 @@ meta constant insert : name_set → name → name_set meta constant erase : name_set → name → name_set meta constant contains : name_set → name → bool meta constant size : name_set → nat +meta constant empty : name_set → bool meta constant fold {α :Type} : name_set → α → (name → α → α) → α meta def to_list (s : name_set) : list name := diff --git a/src/library/locals.cpp b/src/library/locals.cpp index d2960aef08..a6d033d1f1 100644 --- a/src/library/locals.cpp +++ b/src/library/locals.cpp @@ -146,6 +146,23 @@ bool contains_local(expr const & e, name const & n) { return result; } +bool contains_local(expr const & e, name_set const & s) { + if (!has_local(e)) + return false; + bool result = false; + for_each(e, [&](expr const & e, unsigned) { + if (result || !has_local(e)) { + return false; + } else if (is_local(e) && s.contains(mlocal_name(e))) { + result = true; + return false; + } else { + return true; + } + }); + return result; +} + optional depends_on(unsigned sz, expr const * es, expr const & h) { for (unsigned i = 0; i < sz; i++) if (depends_on(es[i], h)) diff --git a/src/library/locals.h b/src/library/locals.h index e551ea9b53..8660d43168 100644 --- a/src/library/locals.h +++ b/src/library/locals.h @@ -45,6 +45,9 @@ bool contains_local(expr const & l, T const & locals) { [&](expr const & l1) { return mlocal_name(l1) == mlocal_name(l); }); } +/** \brief Return true iff \c e contains a local constant \c h s.t. mlocal_name(h) in s */ +bool contains_local(expr const & e, name_set const & s); + /** \brief Return true iff \c e contains a local constant named \c n (it uses mlocal_name) */ bool contains_local(expr const & e, name const & n); diff --git a/src/library/vm/vm_expr.cpp b/src/library/vm/vm_expr.cpp index f3248e1a6d..012ae11fb4 100644 --- a/src/library/vm/vm_expr.cpp +++ b/src/library/vm/vm_expr.cpp @@ -32,6 +32,7 @@ Author: Leonardo de Moura #include "library/vm/vm_list.h" #include "library/vm/vm_string.h" #include "library/vm/vm_pos_info.h" +#include "library/vm/vm_rb_map.h" #include "library/compiler/simp_inductive.h" #include "library/compiler/nat_value.h" @@ -465,6 +466,10 @@ vm_obj expr_pos(vm_obj const &, vm_obj const & e) { return mk_vm_none(); } +vm_obj expr_has_local_in(vm_obj const & e, vm_obj const & s) { + return mk_vm_bool(contains_local(to_expr(e), to_name_set(s))); +} + void initialize_vm_expr() { DECLARE_VM_BUILTIN(name({"expr", "var"}), expr_var); DECLARE_VM_BUILTIN(name({"expr", "sort"}), expr_sort); @@ -501,6 +506,8 @@ void initialize_vm_expr() { DECLARE_VM_BUILTIN(name({"expr", "copy_pos_info"}), expr_copy_pos_info); DECLARE_VM_BUILTIN(name({"expr", "occurs"}), expr_occurs); DECLARE_VM_BUILTIN(name({"expr", "collect_univ_params"}), expr_collect_univ_params); + DECLARE_VM_BUILTIN(name({"expr", "has_local_in"}), expr_has_local_in); + DECLARE_VM_CASES_BUILTIN(name({"expr", "cases_on"}), expr_cases_on); DECLARE_VM_BUILTIN(name("string", "reflect"), reflect_string); diff --git a/src/library/vm/vm_rb_map.cpp b/src/library/vm/vm_rb_map.cpp index f26c36b407..7027a1c5ce 100644 --- a/src/library/vm/vm_rb_map.cpp +++ b/src/library/vm/vm_rb_map.cpp @@ -92,6 +92,10 @@ vm_obj rb_map_size(vm_obj const &, vm_obj const &, vm_obj const & m) { return mk_vm_nat(to_map(m).size()); } +vm_obj rb_map_empty(vm_obj const &, vm_obj const &, vm_obj const & m) { + return mk_vm_bool(to_map(m).empty()); +} + vm_obj rb_map_insert(vm_obj const &, vm_obj const &, vm_obj const & m, vm_obj const & k, vm_obj const & d) { return to_obj(insert(to_map(m), k, d)); } @@ -163,6 +167,10 @@ vm_obj name_set_size(vm_obj const & m) { return mk_vm_nat(to_name_set(m).size()); } +vm_obj name_set_empty(vm_obj const & m) { + return mk_vm_bool(to_name_set(m).empty()); +} + vm_obj name_set_insert(vm_obj const & m, vm_obj const & k) { return to_obj(insert(to_name_set(m), to_name(k))); } @@ -186,6 +194,7 @@ vm_obj name_set_fold(vm_obj const &, vm_obj const & m, vm_obj const & a, vm_obj void initialize_vm_rb_map() { DECLARE_VM_BUILTIN(name({"rb_map", "mk_core"}), rb_map_mk_core); DECLARE_VM_BUILTIN(name({"rb_map", "size"}), rb_map_size); + DECLARE_VM_BUILTIN(name({"rb_map", "empty"}), rb_map_empty); DECLARE_VM_BUILTIN(name({"rb_map", "insert"}), rb_map_insert); DECLARE_VM_BUILTIN(name({"rb_map", "erase"}), rb_map_erase); DECLARE_VM_BUILTIN(name({"rb_map", "contains"}), rb_map_contains); @@ -196,6 +205,7 @@ void initialize_vm_rb_map() { DECLARE_VM_BUILTIN(name({"mk_name_set"}), mk_name_set); DECLARE_VM_BUILTIN(name({"name_set", "size"}), name_set_size); + DECLARE_VM_BUILTIN(name({"name_set", "empty"}), name_set_empty); DECLARE_VM_BUILTIN(name({"name_set", "insert"}), name_set_insert); DECLARE_VM_BUILTIN(name({"name_set", "erase"}), name_set_erase); DECLARE_VM_BUILTIN(name({"name_set", "contains"}), name_set_contains);