feat(kernel/environment): add set_opaque method

Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>

src/kernel/environment.cpp

@@ -11,6 +11,7 @@ Author: Leonardo de Moura
 #include "util/thread.h"
 #include "util/safe_arith.h"
 #include "util/realpath.h"
+#include "util/sstream.h"
 #include "kernel/for_each_fn.h"
 #include "kernel/find_fn.h"
 #include "kernel/kernel_exception.h"
@@ -345,6 +346,13 @@ void environment_cell::add_theorem(name const & n, expr const & t, expr const &
     register_named_object(mk_theorem(n, t, v));
 }
 
+void environment_cell::set_opaque(name const & n, bool opaque) {
+    auto obj = find_object(n);
+    if (!obj || !obj->is_definition())
+        throw kernel_exception(env(), sstream() << "set_opaque failed, '" << n << "' is not a definition");
+    obj->set_opaque(opaque);
+}
+
 /** \brief Add new axiom. */
 void environment_cell::add_axiom(name const & n, expr const & t) {
     check_no_cached_type(t);

src/kernel/environment.h

@@ -164,6 +164,13 @@ public:
     */
     void add_definition(name const & n, expr const & v, bool opaque = false);
 
+    /**
+       \brief Set the given definition as opaque (or not)
+
+       \remark It throws an error if \c n is not a definition.
+    */
+    void set_opaque(name const & n, bool opaque);
+
     /**
        \brief Add a new fact (Axiom or Fact) to the environment.
        It throws an exception if there is already an object with the given name.

src/kernel/kernel_exception.h

@@ -21,6 +21,7 @@ protected:
 public:
     kernel_exception(ro_environment const & env):m_env(env) {}
     kernel_exception(ro_environment const & env, char const * msg):exception(msg), m_env(env) {}
+    kernel_exception(ro_environment const & env, sstream const & strm):exception(strm), m_env(env) {}
     virtual ~kernel_exception() noexcept {}
     ro_environment const & get_environment() const { return m_env; }
     /**

src/kernel/object.cpp

@@ -41,20 +41,22 @@ public:
 };
 
 /**
-   \brief Base class for Axioms and Variable declarations.
+   \brief Builtin object.
 */
 class builtin_object_cell : public object_cell {
     expr m_value;
+    bool m_opaque;
 public:
     builtin_object_cell(expr const & v):
-        object_cell(object_kind::Builtin), m_value(v) { lean_assert(is_value(v)); }
+        object_cell(object_kind::Builtin), m_value(v), m_opaque(false) { lean_assert(is_value(v)); }
     virtual ~builtin_object_cell() {}
     virtual bool has_name() const        { return true; }
     virtual name get_name() const        { return to_value(m_value).get_name(); }
     virtual bool has_type() const        { return true; }
     virtual expr get_type() const        { return to_value(m_value).get_type(); }
     virtual bool is_definition() const   { return true; }
-    virtual bool is_opaque() const { return false; }
+    virtual bool is_opaque() const       { return m_opaque; }
+    virtual void set_opaque(bool f)      { m_opaque = f; }
     virtual expr get_value() const       { return m_value; }
     virtual char const * keyword() const { return "Builtin"; }
     virtual bool is_builtin() const      { return true; }
@@ -141,6 +143,7 @@ public:
 
     virtual bool is_definition() const   { return true; }
     virtual bool is_opaque() const       { return m_opaque; }
+    virtual void set_opaque(bool f)      { m_opaque = f; }
     virtual expr get_value() const       { return m_value; }
     virtual char const * keyword() const { return "Definition"; }
     virtual unsigned get_weight() const  { return m_weight; }

src/kernel/object.h

@@ -15,12 +15,17 @@ Author: Leonardo de Moura
   frontend may need to create new objects for bookkeeping.
 */
 namespace lean {
+class object;
 enum class object_kind { UVarDeclaration, Definition, Postulate, Builtin, BuiltinSet, Neutral };
 
 class object_cell {
+protected:
+    friend class object;
     void dealloc() { delete this; }
     MK_LEAN_RC();
     object_kind m_kind;
+    /** \brief Set the opaque flag */
+    virtual void set_opaque(bool ) { lean_unreachable(); } // LCOV_EXCL_LINE
 public:
     object_cell(object_kind k):m_rc(1), m_kind(k) {}
     virtual ~object_cell() {}
@@ -83,6 +88,8 @@ public:
 class object {
     object_cell * m_ptr;
     explicit object(object_cell * ptr):m_ptr(ptr) {}
+    friend class environment_cell;
+    void set_opaque(bool f) { m_ptr->set_opaque(f); }
 public:
     object(object const & s):m_ptr(s.m_ptr) { if (m_ptr) m_ptr->inc_ref(); }
     object(object && s):m_ptr(s.m_ptr) { s.m_ptr = nullptr; }