diff --git a/src/util/lua.cpp b/src/util/lua.cpp index 9968e6d553..c0c05b8f08 100644 --- a/src/util/lua.cpp +++ b/src/util/lua.cpp @@ -9,9 +9,11 @@ Author: Leonardo de Moura #include #include #include +#include #include "util/lua.h" #include "util/script_exception.h" #include "util/debug.h" +#include "util/sstream.h" namespace lean { /** @@ -131,6 +133,16 @@ bool resume(lua_State * L, int nargs) { return true; } +void throw_bad_arg_error(lua_State * L, int i, char const * expected_type) { + lua_Debug ar; + if (!lua_getstack(L, 0, &ar)) /* no stack frame? */ + throw exception(sstream() << "bad argument #" << i << " (" << expected_type << " expected)"); + lua_getinfo(L, "n", &ar); + if (strcmp(ar.namewhat, "method") == 0 || ar.name == nullptr) + throw exception(sstream() << "bad argument #" << i << " (" << expected_type << " expected)"); + throw exception(sstream() << "bad argument #" << i << " to '" << ar.name << "' (" << expected_type << " expected)"); +} + /** \brief Wrapper for "customers" that are only using a subset of Lean libraries. diff --git a/src/util/lua.h b/src/util/lua.h index fa9332dd7b..46b03d4e6b 100644 --- a/src/util/lua.h +++ b/src/util/lua.h @@ -71,6 +71,8 @@ static int T ## _pred(lua_State * L) { \ return 1; \ } +void throw_bad_arg_error(lua_State * L, int i, char const * expected_type); + /** \brief Create basic declarations for adding a new kind of userdata in Lua T is a Lean object type. @@ -85,11 +87,11 @@ static int T ## _pred(lua_State * L) { \ int push_expr(lua_State * L, expr const & e); int push_expr(lua_State * L, expr && e); */ -#define DECL_UDATA(T) \ +#define DECL_UDATA(T) \ constexpr char const * T ## _mt = #T; \ -T & to_ ## T(lua_State * L, int i) { return *static_cast(luaL_checkudata(L, i, T ## _mt)); } \ -DECL_PRED(T) \ -DECL_GC(T) \ +DECL_PRED(T) \ +T & to_ ## T(lua_State * L, int i) { if (!is_ ## T(L, i)) throw_bad_arg_error(L, i, T ## _mt); return *static_cast(luaL_checkudata(L, i, T ## _mt)); } \ +DECL_GC(T) \ DECL_PUSH(T) /** diff --git a/tests/lean/loop3.lean b/tests/lean/loop3.lean new file mode 100644 index 0000000000..8a957924c7 --- /dev/null +++ b/tests/lean/loop3.lean @@ -0,0 +1,37 @@ +variable vec : Nat → Type +variable concat {n m : Nat} (v : vec n) (w : vec m) : vec (n + m) +infixl 65 ; : concat +axiom concat_assoc {n1 n2 n3 : Nat} (v1 : vec n1) (v2 : vec n2) (v3 : vec n3) : + (v1 ; v2) ; v3 = cast (congr2 vec (symm (Nat::add_assoc n1 n2 n3))) + (v1 ; (v2 ; v3)) +variable empty : vec 0 +axiom concat_empty {n : Nat} (v : vec n) : + v ; empty = cast (congr2 vec (symm (Nat::add_zeror n))) + v + +rewrite_set simple +add_rewrite Nat::add_assoc Nat::add_zeror eq_id : simple +add_rewrite concat_assoc concat_empty Nat::add_assoc Nat::add_zeror : simple + +(* +local opts = options({"simplifier", "heq"}, true) +local t = parse_lean('∀ (n : Nat) (v : vec (n + 0)) (w : vec n), v = w ; empty') +print(t) +local t2, pr = simplify(t, "simple", heq) +print("====>") +print(t2) +get_environment():type_check(pr) +*) + +print "STEP 1" +print "STEP 2" + +(* +local opts = options({"simplifier", "heq"}, true) +local t = parse_lean('λ n : Nat, ∃ (v : vec (n + 0)) (w : vec n), v ≠ w ; empty') +print(t) +local t2, pr = simplify(t, "simple", opts) +print("====>") +print(t2) +get_environment():type_check(pr) +*) diff --git a/tests/lean/loop3.lean.expected.out b/tests/lean/loop3.lean.expected.out new file mode 100644 index 0000000000..a5f3954c4a --- /dev/null +++ b/tests/lean/loop3.lean.expected.out @@ -0,0 +1,15 @@ + Set: pp::colors + Set: pp::unicode + Assumed: vec + Assumed: concat + Assumed: concat_assoc + Assumed: empty + Assumed: concat_empty +∀ (n : ℕ) (v : vec (n + 0)) (w : vec n), v = w ; empty +loop3.lean:20: error: executing script +error: bad argument #3 to 'simplify' (options expected) +STEP 1 +STEP 2 +λ n : ℕ, ∃ (v : vec (n + 0)) (w : vec n), v ≠ w ; empty +====> +λ n : ℕ, ∃ v x : vec n, v ≠ x