From 3169f8c12623819632de38cb988f4710baa6e7ec Mon Sep 17 00:00:00 2001
From: Leonardo de Moura <leonardo@microsoft.com>
Date: Tue, 24 Jun 2014 12:11:27 -0700
Subject: [PATCH] feat(library): add mk_explicit/is_explicit procedures for
 '@'-expressions

Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
---
 src/library/CMakeLists.txt    |  2 +-
 src/library/explicit.cpp      | 57 +++++++++++++++++++++++++++++++++++
 src/library/explicit.h        | 25 +++++++++++++++
 src/library/register_module.h |  2 ++
 tests/lua/explicit.lua        |  7 +++++
 5 files changed, 92 insertions(+), 1 deletion(-)
 create mode 100644 src/library/explicit.cpp
 create mode 100644 src/library/explicit.h
 create mode 100644 tests/lua/explicit.lua

diff --git a/src/library/CMakeLists.txt b/src/library/CMakeLists.txt
index 46179eb56..1371a0d42 100644
--- a/src/library/CMakeLists.txt
+++ b/src/library/CMakeLists.txt
@@ -4,7 +4,7 @@ add_library(library deep_copy.cpp expr_lt.cpp io_state.cpp occurs.cpp
   normalize.cpp shared_environment.cpp module.cpp coercion.cpp
   private.cpp placeholder.cpp aliases.cpp level_names.cpp
   update_declaration.cpp choice.cpp scoped_ext.cpp locals.cpp
-  unifier.cpp)
+  unifier.cpp explicit.cpp)
 # hop_match.cpp)
 
 target_link_libraries(library ${LEAN_LIBS})
diff --git a/src/library/explicit.cpp b/src/library/explicit.cpp
new file mode 100644
index 000000000..cadc90be5
--- /dev/null
+++ b/src/library/explicit.cpp
@@ -0,0 +1,57 @@
+/*
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+
+Author: Leonardo de Moura
+*/
+#include "util/sstream.h"
+#include "library/explicit.h"
+#include "library/kernel_bindings.h"
+
+namespace lean {
+static name g_explicit_name("@");
+[[ noreturn ]] static void throw_ex() { throw exception("unexpected occurrence of '@' expression"); }
+
+// We encode the 'explicit' expression mark '@' using a macro.
+// This is a trick to avoid creating a new kind of expression.
+// 'Explicit' expressions are temporary objects used by the elaborator,
+// and have no semantic significance.
+class explicit_macro_cell : public macro_definition_cell {
+public:
+    virtual name get_name() const { return g_explicit_name; }
+    virtual expr get_type(expr const &, expr const *, extension_context &) const { throw_ex(); }
+    virtual optional<expr> expand(expr const &, extension_context &) const { throw_ex(); }
+    virtual void write(serializer &) const { throw_ex(); }
+};
+
+static macro_definition g_explicit(new explicit_macro_cell());
+expr mk_explicit(expr const & e) {
+    return mk_macro(g_explicit, 1, &e);
+}
+
+bool is_explicit(expr const & e) {
+    return is_macro(e) && macro_def(e) == g_explicit;
+}
+
+expr const & get_explicit_arg(expr const & e) {
+    lean_assert(is_explicit(e));
+    return macro_arg(e, 0);
+}
+
+static int mk_explicit(lua_State * L) { return push_expr(L, mk_explicit(to_expr(L, 1))); }
+static int is_explicit(lua_State * L) { return push_boolean(L, is_explicit(to_expr(L, 1))); }
+static void check_explicit(lua_State * L, int idx) {
+    if (!is_explicit(to_expr(L, idx)))
+        throw exception(sstream() << "arg #" << idx << " is not a '@'-expression");
+}
+static int get_explicit_arg(lua_State * L) {
+    check_explicit(L, 1);
+    return push_expr(L, get_explicit_arg(to_expr(L, 1)));
+}
+
+void open_explicit(lua_State * L) {
+    SET_GLOBAL_FUN(mk_explicit,      "mk_explicit");
+    SET_GLOBAL_FUN(is_explicit,      "is_explicit");
+    SET_GLOBAL_FUN(get_explicit_arg, "get_explicit_arg");
+}
+}
diff --git a/src/library/explicit.h b/src/library/explicit.h
new file mode 100644
index 000000000..938a6dbe1
--- /dev/null
+++ b/src/library/explicit.h
@@ -0,0 +1,25 @@
+/*
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+
+Author: Leonardo de Moura
+*/
+#pragma once
+#include "util/lua.h"
+#include "kernel/expr.h"
+
+namespace lean {
+/**
+    \brief Create an explicit expression '@ f'.
+    This only affects the elaborator behavior.
+*/
+expr mk_explicit(expr const & e);
+/** \brief Return true iff \c e is an explicit expression. */
+bool is_explicit(expr const & e);
+/**
+   \brief Return the argument of an explicit expression.
+   \pre is_explicit(e)
+*/
+expr const & get_explicit_arg(expr const & e);
+void open_explicit(lua_State * L);
+}
diff --git a/src/library/register_module.h b/src/library/register_module.h
index 18d491ca5..05efab159 100644
--- a/src/library/register_module.h
+++ b/src/library/register_module.h
@@ -13,6 +13,7 @@ Author: Leonardo de Moura
 #include "library/placeholder.h"
 #include "library/aliases.h"
 #include "library/choice.h"
+#include "library/explicit.h"
 #include "library/unifier.h"
 #include "library/scoped_ext.h"
 // #include "library/hop_match.h"
@@ -28,6 +29,7 @@ inline void open_core_module(lua_State * L) {
     open_choice(L);
     open_scoped_ext(L);
     open_unifier(L);
+    open_explicit(L);
     // open_hop_match(L);
 }
 inline void register_core_module() {
diff --git a/tests/lua/explicit.lua b/tests/lua/explicit.lua
new file mode 100644
index 000000000..671458b01
--- /dev/null
+++ b/tests/lua/explicit.lua
@@ -0,0 +1,7 @@
+local f = Const("f")
+local a = Const("a")
+print(mk_explicit(f)(a))
+assert(is_explicit(mk_explicit(f)))
+assert(not is_explicit(f))
+assert(get_explicit_arg(mk_explicit(f)) == f)
+check_error(function() get_explicit_arg(f) end)