/* Copyright (c) 2013 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Leonardo de Moura */ #include #include #include "util/debug.h" #include "util/sexpr/sexpr.h" #include "bindings/lua/util.h" #include "bindings/lua/name.h" #include "bindings/lua/numerics.h" namespace lean { constexpr char const * sexpr_mt = "sexpr.mt"; int push_sexpr(lua_State * L, sexpr const & e) { void * mem = lua_newuserdata(L, sizeof(sexpr)); new (mem) sexpr(e); luaL_getmetatable(L, sexpr_mt); lua_setmetatable(L, -2); return 1; } bool is_sexpr(lua_State * L, int idx) { return testudata(L, idx, sexpr_mt); } sexpr & to_sexpr(lua_State * L, int idx) { return *static_cast(lua_touserdata(L, idx)); } static int sexpr_gc(lua_State * L) { to_sexpr(L, 1).~sexpr(); return 0; } static int sexpr_tostring(lua_State * L) { std::ostringstream out; out << to_sexpr(L, 1); lua_pushfstring(L, out.str().c_str()); return 1; } static sexpr to_sexpr_elem(lua_State * L, int idx) { if (lua_isnil(L, idx)) { return sexpr(); } else if (lua_isboolean(L, idx)) { return sexpr(static_cast(lua_toboolean(L, idx))); } else if (lua_isnumber(L, idx)) { // Remark: we convert to integer by default return sexpr(static_cast(lua_tointeger(L, idx))); } else if (is_name(L, idx)) { return sexpr(to_name(L, idx)); } else if (is_sexpr(L, idx)) { return *static_cast(lua_touserdata(L, idx)); } else if (is_mpz(L, idx)) { return sexpr(to_mpz(L, idx)); } else if (is_mpq(L, idx)) { return sexpr(to_mpq(L, idx)); } else { return sexpr(lua_tostring(L, idx)); } } static int mk_sexpr(lua_State * L) { sexpr r; int nargs = lua_gettop(L); if (nargs == 0) { r = sexpr(); } else { int i = nargs; r = to_sexpr_elem(L, i); i--; for (; i >= 1; i--) { r = sexpr(to_sexpr_elem(L, i), r); } } return push_sexpr(L, r); } static int sexpr_eq(lua_State * L) { lua_pushboolean(L, to_sexpr(L, 1) == to_sexpr(L, 2)); return 1; } static int sexpr_lt(lua_State * L) { lua_pushboolean(L, to_sexpr(L, 1) < to_sexpr(L, 2)); return 1; } static int sexpr_is_nil(lua_State * L) { lua_pushboolean(L, is_nil(to_sexpr(L, 1))); return 1; } static int sexpr_is_cons(lua_State * L) { lua_pushboolean(L, is_cons(to_sexpr(L, 1))); return 1; } static int sexpr_is_list(lua_State * L) { lua_pushboolean(L, is_list(to_sexpr(L, 1))); return 1; } static int sexpr_is_atom(lua_State * L) { lua_pushboolean(L, is_atom(to_sexpr(L, 1))); return 1; } static int sexpr_is_string(lua_State * L) { lua_pushboolean(L, is_string(to_sexpr(L, 1))); return 1; } static int sexpr_is_bool(lua_State * L) { lua_pushboolean(L, is_bool(to_sexpr(L, 1))); return 1; } static int sexpr_is_int(lua_State * L) { lua_pushboolean(L, is_int(to_sexpr(L, 1))); return 1; } static int sexpr_is_double(lua_State * L) { lua_pushboolean(L, is_double(to_sexpr(L, 1))); return 1; } static int sexpr_is_name(lua_State * L) { lua_pushboolean(L, is_name(to_sexpr(L, 1))); return 1; } static int sexpr_is_mpz(lua_State * L) { lua_pushboolean(L, is_mpz(to_sexpr(L, 1))); return 1; } static int sexpr_is_mpq(lua_State * L) { lua_pushboolean(L, is_mpq(to_sexpr(L, 1))); return 1; } static int sexpr_length(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_list(e)) throw exception("s-expression is not a list"); lua_pushinteger(L, length(e)); return 1; } static int sexpr_head(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_cons(e)) throw exception("s-expression is not a cons cell"); return push_sexpr(L, head(e)); } static int sexpr_tail(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_cons(e)) throw exception("s-expression is not a cons cell"); return push_sexpr(L, tail(e)); } static int sexpr_to_bool(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_bool(e)) throw exception("s-expression is not a Boolean"); lua_pushboolean(L, to_bool(e)); return 1; } static int sexpr_to_string(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_string(e)) throw exception("s-expression is not a string"); lua_pushfstring(L, to_string(e).c_str()); return 1; } static int sexpr_to_int(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_int(e)) throw exception("s-expression is not an integer"); lua_pushinteger(L, to_int(e)); return 1; } static int sexpr_to_double(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_double(e)) throw exception("s-expression is not a double"); lua_pushnumber(L, to_double(e)); return 1; } static int sexpr_to_name(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_name(e)) throw exception("s-expression is not a name"); return push_name(L, to_name(e)); } static int sexpr_to_mpz(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_mpz(e)) throw exception("s-expression is not a multi-precision integer"); return push_mpz(L, to_mpz(e)); } static int sexpr_to_mpq(lua_State * L) { sexpr const & e = to_sexpr(L, 1); if (!is_mpq(e)) throw exception("s-expression is not a multi-precision rational"); return push_mpq(L, to_mpq(e)); } static int sexpr_pred(lua_State * L) { lua_pushboolean(L, is_sexpr(L, 1)); return 1; } static int sexpr_get_kind(lua_State * L) { lua_pushinteger(L, static_cast(to_sexpr(L, 1).kind())); return 1; } static int sexpr_fields(lua_State * L) { sexpr const & e = to_sexpr(L, 1); switch (e.kind()) { case sexpr_kind::Nil: return 0; case sexpr_kind::String: return sexpr_to_string(L); case sexpr_kind::Bool: return sexpr_to_bool(L); case sexpr_kind::Int: return sexpr_to_int(L); case sexpr_kind::Double: return sexpr_to_double(L); case sexpr_kind::Name: return sexpr_to_name(L); case sexpr_kind::MPZ: return sexpr_to_mpz(L); case sexpr_kind::MPQ: return sexpr_to_mpq(L); case sexpr_kind::Cons: sexpr_head(L); sexpr_tail(L); return 2; } lean_unreachable(); // LCOV_EXCL_LINE return 0; // LCOV_EXCL_LINE } static const struct luaL_Reg sexpr_m[] = { {"__gc", sexpr_gc}, // never throws {"__tostring", safe_function}, {"__eq", safe_function}, {"__lt", safe_function}, {"kind", safe_function}, {"is_nil", safe_function}, {"is_cons", safe_function}, {"is_list", safe_function}, {"is_atom", safe_function}, {"is_string", safe_function}, {"is_bool", safe_function}, {"is_int", safe_function}, {"is_double", safe_function}, {"is_name", safe_function}, {"is_mpz", safe_function}, {"is_mpq", safe_function}, {"head", safe_function}, {"tail", safe_function}, {"length", safe_function}, {"to_bool", safe_function}, {"to_string", safe_function}, {"to_int", safe_function}, {"to_double", safe_function}, {"to_name", safe_function}, {"to_mpz", safe_function}, {"to_mpq", safe_function}, {"fields", safe_function}, {0, 0} }; void open_sexpr(lua_State * L) { luaL_newmetatable(L, sexpr_mt); lua_pushvalue(L, -1); lua_setfield(L, -2, "__index"); setfuncs(L, sexpr_m, 0); SET_GLOBAL_FUN(mk_sexpr, "sexpr"); SET_GLOBAL_FUN(sexpr_pred, "is_sexpr"); lua_newtable(L); SET_ENUM("Nil", sexpr_kind::Nil); SET_ENUM("String", sexpr_kind::String); SET_ENUM("Bool", sexpr_kind::Bool); SET_ENUM("Int", sexpr_kind::Int); SET_ENUM("Double", sexpr_kind::Double); SET_ENUM("Name", sexpr_kind::Name); SET_ENUM("MPZ", sexpr_kind::MPZ); SET_ENUM("MPQ", sexpr_kind::MPQ); SET_ENUM("Cons", sexpr_kind::Cons); lua_setglobal(L, "sexpr_kind"); } }