2013-07-22 11:03:46 +00:00
|
|
|
/*
|
|
|
|
Copyright (c) 2013 Microsoft Corporation. All rights reserved.
|
|
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
|
|
|
|
|
|
|
Author: Leonardo de Moura
|
2013-08-01 22:42:06 +00:00
|
|
|
Soonho Kong
|
2013-07-22 11:03:46 +00:00
|
|
|
*/
|
|
|
|
#include <vector>
|
2013-08-01 22:42:06 +00:00
|
|
|
#include <sstream>
|
2013-12-28 09:16:50 +00:00
|
|
|
#include <string>
|
2014-01-21 01:40:44 +00:00
|
|
|
#include <algorithm>
|
2014-04-17 23:10:47 +00:00
|
|
|
#include <limits>
|
2014-02-16 17:53:55 +00:00
|
|
|
#include "util/list_fn.h"
|
2013-09-13 03:04:10 +00:00
|
|
|
#include "util/hash.h"
|
2013-11-19 02:41:08 +00:00
|
|
|
#include "util/buffer.h"
|
2013-12-28 09:16:50 +00:00
|
|
|
#include "util/object_serializer.h"
|
2013-09-13 03:04:10 +00:00
|
|
|
#include "kernel/expr.h"
|
2014-02-16 17:53:55 +00:00
|
|
|
#include "kernel/expr_eq_fn.h"
|
2014-02-18 00:10:11 +00:00
|
|
|
#include "kernel/free_vars.h"
|
2014-02-18 05:32:24 +00:00
|
|
|
#include "kernel/max_sharing.h"
|
2013-07-22 11:03:46 +00:00
|
|
|
|
|
|
|
namespace lean {
|
2013-12-08 07:21:07 +00:00
|
|
|
static expr g_dummy(mk_var(0));
|
|
|
|
expr::expr():expr(g_dummy) {}
|
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
unsigned hash_levels(levels const & ls) {
|
|
|
|
unsigned r = 23;
|
|
|
|
for (auto const & l : ls)
|
|
|
|
r = hash(hash(l), r);
|
|
|
|
return r;
|
2013-09-27 01:24:45 +00:00
|
|
|
}
|
2013-09-13 01:25:38 +00:00
|
|
|
|
2014-03-01 01:16:34 +00:00
|
|
|
expr_cell::expr_cell(expr_kind k, unsigned h, bool has_mv, bool has_local, bool has_param_univ):
|
2013-07-23 15:59:39 +00:00
|
|
|
m_kind(static_cast<unsigned>(k)),
|
2014-02-20 18:07:38 +00:00
|
|
|
m_flags(0),
|
|
|
|
m_has_mv(has_mv),
|
|
|
|
m_has_local(has_local),
|
2014-03-01 01:16:34 +00:00
|
|
|
m_has_param_univ(has_param_univ),
|
2013-07-22 11:03:46 +00:00
|
|
|
m_hash(h),
|
2013-12-08 18:17:29 +00:00
|
|
|
m_rc(0) {
|
2013-11-14 10:31:54 +00:00
|
|
|
// m_hash_alloc does not need to be a unique identifier.
|
2014-02-16 17:53:55 +00:00
|
|
|
// We want diverse hash codes because given expr_cell * c1 and expr_cell * c2,
|
2013-11-14 10:31:54 +00:00
|
|
|
// if c1 != c2, then there is high probability c1->m_hash_alloc != c2->m_hash_alloc.
|
|
|
|
// Remark: using pointer address as a hash code is not a good idea.
|
|
|
|
// - each execution run will behave differently.
|
|
|
|
// - the hash is not diverse enough
|
2013-12-09 22:56:48 +00:00
|
|
|
static LEAN_THREAD_LOCAL unsigned g_hash_alloc_counter = 0;
|
2013-11-14 10:31:54 +00:00
|
|
|
m_hash_alloc = g_hash_alloc_counter;
|
|
|
|
g_hash_alloc_counter++;
|
|
|
|
}
|
2013-07-22 11:03:46 +00:00
|
|
|
|
2013-11-19 02:41:08 +00:00
|
|
|
void expr_cell::dec_ref(expr & e, buffer<expr_cell*> & todelete) {
|
2013-12-08 07:21:07 +00:00
|
|
|
if (e.m_ptr) {
|
2013-11-19 02:41:08 +00:00
|
|
|
expr_cell * c = e.steal_ptr();
|
2013-12-08 07:21:07 +00:00
|
|
|
lean_assert(!(e.m_ptr));
|
2013-11-19 02:41:08 +00:00
|
|
|
if (c->dec_ref_core())
|
|
|
|
todelete.push_back(c);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2013-12-21 21:59:45 +00:00
|
|
|
optional<bool> expr_cell::is_arrow() const {
|
2014-04-22 22:38:18 +00:00
|
|
|
// it is stored in bits 0-1
|
|
|
|
unsigned r = (m_flags & (1+2));
|
2013-12-21 21:59:45 +00:00
|
|
|
if (r == 0) {
|
|
|
|
return optional<bool>();
|
|
|
|
} else if (r == 1) {
|
|
|
|
return optional<bool>(true);
|
|
|
|
} else {
|
|
|
|
lean_assert(r == 2);
|
|
|
|
return optional<bool>(false);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void expr_cell::set_is_arrow(bool flag) {
|
2014-04-22 22:38:18 +00:00
|
|
|
unsigned mask = flag ? 1 : 2;
|
2013-12-21 21:59:45 +00:00
|
|
|
m_flags |= mask;
|
|
|
|
lean_assert(is_arrow() && *is_arrow() == flag);
|
|
|
|
}
|
|
|
|
|
2014-04-24 03:16:14 +00:00
|
|
|
bool is_meta(expr const & e) {
|
|
|
|
expr const * it = &e;
|
|
|
|
while (is_app(*it)) {
|
|
|
|
it = &(app_fn(*it));
|
|
|
|
}
|
|
|
|
return is_metavar(*it);
|
|
|
|
}
|
|
|
|
|
refactor(kernel): add heterogeneous equality back to expr
The main motivation is that we will be able to move equalities between universes.
For example, suppose we have
A : (Type i)
B : (Type i)
H : @eq (Type j) A B
where j > i
We didn't find any trick for deducing (@eq (Type i) A B) from H.
Before this commit, heterogeneous equality as a constant with type
heq : {A B : (Type U)} : A -> B -> Bool
So, from H, we would only be able to deduce
(@heq (Type j) (Type j) A B)
Not being able to move the equality back to a smaller universe is
problematic in several cases. I list some instances in the end of the commit message.
With this commit, Heterogeneous equality is a special kind of expression.
It is not a constant anymore. From H, we can deduce
H1 : A == B
That is, we are essentially "erasing" the universes when we move to heterogeneous equality.
Now, since A and B have (Type i), we can deduce (@eq (Type i) A B) from H1. The proof term is
(to_eq (Type i) A B (to_heq (Type j) A B H)) : (@eq (Type i) A B)
So, it remains to explain why we need this feature.
For example, suppose we want to state the Pi extensionality axiom.
axiom hpiext {A A' : (Type U)} {B : A → (Type U)} {B' : A' → (Type U)} :
A = A' → (∀ x x', x == x' → B x == B' x') → (∀ x, B x) == (∀ x, B' x)
This axiom produces an "inflated" equality at (Type U) when we treat heterogeneous
equality as a constant. The conclusion
(∀ x, B x) == (∀ x, B' x)
is syntax sugar for
(@heq (Type U) (Type U) (∀ x : A, B x) (∀ x : A', B' x))
Even if A, A', B, B' live in a much smaller universe.
As I described above, it doesn't seem to be a way to move this equality back to a smaller universe.
So, if we wanted to keep the heterogeneous equality as a constant, it seems we would
have to support axiom schemas. That is, hpiext would be parametrized by the universes where
A, A', B and B'. Another possibility would be to have universe polymorphism like Agda.
None of the solutions seem attractive.
So, we decided to have heterogeneous equality as a special kind of expression.
And use the trick above to move equalities back to the right universe.
BTW, the parser is not creating the new heterogeneous equalities yet.
Moreover, kernel.lean still contains a constant name heq2 that is the heterogeneous
equality as a constant.
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
2014-02-07 18:07:08 +00:00
|
|
|
// Expr variables
|
2013-07-22 11:03:46 +00:00
|
|
|
expr_var::expr_var(unsigned idx):
|
2014-03-01 01:16:34 +00:00
|
|
|
expr_cell(expr_kind::Var, idx, false, false, false),
|
2014-04-17 20:25:21 +00:00
|
|
|
m_vidx(idx) {
|
|
|
|
if (idx == std::numeric_limits<unsigned>::max())
|
|
|
|
throw exception("invalid free variable index, de Bruijn index is too big");
|
|
|
|
}
|
2013-07-22 11:03:46 +00:00
|
|
|
|
refactor(kernel): add heterogeneous equality back to expr
The main motivation is that we will be able to move equalities between universes.
For example, suppose we have
A : (Type i)
B : (Type i)
H : @eq (Type j) A B
where j > i
We didn't find any trick for deducing (@eq (Type i) A B) from H.
Before this commit, heterogeneous equality as a constant with type
heq : {A B : (Type U)} : A -> B -> Bool
So, from H, we would only be able to deduce
(@heq (Type j) (Type j) A B)
Not being able to move the equality back to a smaller universe is
problematic in several cases. I list some instances in the end of the commit message.
With this commit, Heterogeneous equality is a special kind of expression.
It is not a constant anymore. From H, we can deduce
H1 : A == B
That is, we are essentially "erasing" the universes when we move to heterogeneous equality.
Now, since A and B have (Type i), we can deduce (@eq (Type i) A B) from H1. The proof term is
(to_eq (Type i) A B (to_heq (Type j) A B H)) : (@eq (Type i) A B)
So, it remains to explain why we need this feature.
For example, suppose we want to state the Pi extensionality axiom.
axiom hpiext {A A' : (Type U)} {B : A → (Type U)} {B' : A' → (Type U)} :
A = A' → (∀ x x', x == x' → B x == B' x') → (∀ x, B x) == (∀ x, B' x)
This axiom produces an "inflated" equality at (Type U) when we treat heterogeneous
equality as a constant. The conclusion
(∀ x, B x) == (∀ x, B' x)
is syntax sugar for
(@heq (Type U) (Type U) (∀ x : A, B x) (∀ x : A', B' x))
Even if A, A', B, B' live in a much smaller universe.
As I described above, it doesn't seem to be a way to move this equality back to a smaller universe.
So, if we wanted to keep the heterogeneous equality as a constant, it seems we would
have to support axiom schemas. That is, hpiext would be parametrized by the universes where
A, A', B and B'. Another possibility would be to have universe polymorphism like Agda.
None of the solutions seem attractive.
So, we decided to have heterogeneous equality as a special kind of expression.
And use the trick above to move equalities back to the right universe.
BTW, the parser is not creating the new heterogeneous equalities yet.
Moreover, kernel.lean still contains a constant name heq2 that is the heterogeneous
equality as a constant.
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
2014-02-07 18:07:08 +00:00
|
|
|
// Expr constants
|
2014-02-16 17:53:55 +00:00
|
|
|
expr_const::expr_const(name const & n, levels const & ls):
|
2014-03-01 01:16:34 +00:00
|
|
|
expr_cell(expr_kind::Constant, ::lean::hash(n.hash(), hash_levels(ls)), has_meta(ls), false, has_param(ls)),
|
2014-02-16 17:53:55 +00:00
|
|
|
m_name(n),
|
|
|
|
m_levels(ls) {}
|
|
|
|
|
|
|
|
// Expr metavariables and local variables
|
|
|
|
expr_mlocal::expr_mlocal(bool is_meta, name const & n, expr const & t):
|
2014-03-01 01:16:34 +00:00
|
|
|
expr_cell(is_meta ? expr_kind::Meta : expr_kind::Local, n.hash(), is_meta || t.has_metavar(), !is_meta || t.has_local(), t.has_param_univ()),
|
2013-11-19 19:21:45 +00:00
|
|
|
m_name(n),
|
|
|
|
m_type(t) {}
|
2014-02-16 17:53:55 +00:00
|
|
|
void expr_mlocal::dealloc(buffer<expr_cell*> & todelete) {
|
2013-11-19 19:21:45 +00:00
|
|
|
dec_ref(m_type, todelete);
|
|
|
|
delete(this);
|
|
|
|
}
|
refactor(kernel): add heterogeneous equality back to expr
The main motivation is that we will be able to move equalities between universes.
For example, suppose we have
A : (Type i)
B : (Type i)
H : @eq (Type j) A B
where j > i
We didn't find any trick for deducing (@eq (Type i) A B) from H.
Before this commit, heterogeneous equality as a constant with type
heq : {A B : (Type U)} : A -> B -> Bool
So, from H, we would only be able to deduce
(@heq (Type j) (Type j) A B)
Not being able to move the equality back to a smaller universe is
problematic in several cases. I list some instances in the end of the commit message.
With this commit, Heterogeneous equality is a special kind of expression.
It is not a constant anymore. From H, we can deduce
H1 : A == B
That is, we are essentially "erasing" the universes when we move to heterogeneous equality.
Now, since A and B have (Type i), we can deduce (@eq (Type i) A B) from H1. The proof term is
(to_eq (Type i) A B (to_heq (Type j) A B H)) : (@eq (Type i) A B)
So, it remains to explain why we need this feature.
For example, suppose we want to state the Pi extensionality axiom.
axiom hpiext {A A' : (Type U)} {B : A → (Type U)} {B' : A' → (Type U)} :
A = A' → (∀ x x', x == x' → B x == B' x') → (∀ x, B x) == (∀ x, B' x)
This axiom produces an "inflated" equality at (Type U) when we treat heterogeneous
equality as a constant. The conclusion
(∀ x, B x) == (∀ x, B' x)
is syntax sugar for
(@heq (Type U) (Type U) (∀ x : A, B x) (∀ x : A', B' x))
Even if A, A', B, B' live in a much smaller universe.
As I described above, it doesn't seem to be a way to move this equality back to a smaller universe.
So, if we wanted to keep the heterogeneous equality as a constant, it seems we would
have to support axiom schemas. That is, hpiext would be parametrized by the universes where
A, A', B and B'. Another possibility would be to have universe polymorphism like Agda.
None of the solutions seem attractive.
So, we decided to have heterogeneous equality as a special kind of expression.
And use the trick above to move equalities back to the right universe.
BTW, the parser is not creating the new heterogeneous equalities yet.
Moreover, kernel.lean still contains a constant name heq2 that is the heterogeneous
equality as a constant.
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
2014-02-07 18:07:08 +00:00
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
// Composite expressions
|
2014-04-17 18:31:48 +00:00
|
|
|
expr_composite::expr_composite(expr_kind k, unsigned h, bool has_mv, bool has_local, bool has_param_univ, unsigned d, unsigned fv_range):
|
2014-03-01 01:16:34 +00:00
|
|
|
expr_cell(k, h, has_mv, has_local, has_param_univ),
|
2014-04-17 18:31:48 +00:00
|
|
|
m_depth(d),
|
|
|
|
m_free_var_range(fv_range) {}
|
refactor(kernel): add heterogeneous equality back to expr
The main motivation is that we will be able to move equalities between universes.
For example, suppose we have
A : (Type i)
B : (Type i)
H : @eq (Type j) A B
where j > i
We didn't find any trick for deducing (@eq (Type i) A B) from H.
Before this commit, heterogeneous equality as a constant with type
heq : {A B : (Type U)} : A -> B -> Bool
So, from H, we would only be able to deduce
(@heq (Type j) (Type j) A B)
Not being able to move the equality back to a smaller universe is
problematic in several cases. I list some instances in the end of the commit message.
With this commit, Heterogeneous equality is a special kind of expression.
It is not a constant anymore. From H, we can deduce
H1 : A == B
That is, we are essentially "erasing" the universes when we move to heterogeneous equality.
Now, since A and B have (Type i), we can deduce (@eq (Type i) A B) from H1. The proof term is
(to_eq (Type i) A B (to_heq (Type j) A B H)) : (@eq (Type i) A B)
So, it remains to explain why we need this feature.
For example, suppose we want to state the Pi extensionality axiom.
axiom hpiext {A A' : (Type U)} {B : A → (Type U)} {B' : A' → (Type U)} :
A = A' → (∀ x x', x == x' → B x == B' x') → (∀ x, B x) == (∀ x, B' x)
This axiom produces an "inflated" equality at (Type U) when we treat heterogeneous
equality as a constant. The conclusion
(∀ x, B x) == (∀ x, B' x)
is syntax sugar for
(@heq (Type U) (Type U) (∀ x : A, B x) (∀ x : A', B' x))
Even if A, A', B, B' live in a much smaller universe.
As I described above, it doesn't seem to be a way to move this equality back to a smaller universe.
So, if we wanted to keep the heterogeneous equality as a constant, it seems we would
have to support axiom schemas. That is, hpiext would be parametrized by the universes where
A, A', B and B'. Another possibility would be to have universe polymorphism like Agda.
None of the solutions seem attractive.
So, we decided to have heterogeneous equality as a special kind of expression.
And use the trick above to move equalities back to the right universe.
BTW, the parser is not creating the new heterogeneous equalities yet.
Moreover, kernel.lean still contains a constant name heq2 that is the heterogeneous
equality as a constant.
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
2014-02-07 18:07:08 +00:00
|
|
|
|
|
|
|
// Expr applications
|
2014-02-16 17:53:55 +00:00
|
|
|
expr_app::expr_app(expr const & fn, expr const & arg):
|
2014-02-20 18:07:38 +00:00
|
|
|
expr_composite(expr_kind::App, ::lean::hash(fn.hash(), arg.hash()),
|
2014-03-01 01:16:34 +00:00
|
|
|
fn.has_metavar() || arg.has_metavar(),
|
|
|
|
fn.has_local() || arg.has_local(),
|
|
|
|
fn.has_param_univ() || arg.has_param_univ(),
|
2014-04-17 18:31:48 +00:00
|
|
|
std::max(get_depth(fn), get_depth(arg)) + 1,
|
|
|
|
std::max(get_free_var_range(fn), get_free_var_range(arg))),
|
2014-02-16 17:53:55 +00:00
|
|
|
m_fn(fn), m_arg(arg) {}
|
2013-11-19 02:41:08 +00:00
|
|
|
void expr_app::dealloc(buffer<expr_cell*> & todelete) {
|
2014-02-16 17:53:55 +00:00
|
|
|
dec_ref(m_fn, todelete);
|
|
|
|
dec_ref(m_arg, todelete);
|
|
|
|
delete(this);
|
2013-07-22 11:03:46 +00:00
|
|
|
}
|
refactor(kernel): add heterogeneous equality back to expr
The main motivation is that we will be able to move equalities between universes.
For example, suppose we have
A : (Type i)
B : (Type i)
H : @eq (Type j) A B
where j > i
We didn't find any trick for deducing (@eq (Type i) A B) from H.
Before this commit, heterogeneous equality as a constant with type
heq : {A B : (Type U)} : A -> B -> Bool
So, from H, we would only be able to deduce
(@heq (Type j) (Type j) A B)
Not being able to move the equality back to a smaller universe is
problematic in several cases. I list some instances in the end of the commit message.
With this commit, Heterogeneous equality is a special kind of expression.
It is not a constant anymore. From H, we can deduce
H1 : A == B
That is, we are essentially "erasing" the universes when we move to heterogeneous equality.
Now, since A and B have (Type i), we can deduce (@eq (Type i) A B) from H1. The proof term is
(to_eq (Type i) A B (to_heq (Type j) A B H)) : (@eq (Type i) A B)
So, it remains to explain why we need this feature.
For example, suppose we want to state the Pi extensionality axiom.
axiom hpiext {A A' : (Type U)} {B : A → (Type U)} {B' : A' → (Type U)} :
A = A' → (∀ x x', x == x' → B x == B' x') → (∀ x, B x) == (∀ x, B' x)
This axiom produces an "inflated" equality at (Type U) when we treat heterogeneous
equality as a constant. The conclusion
(∀ x, B x) == (∀ x, B' x)
is syntax sugar for
(@heq (Type U) (Type U) (∀ x : A, B x) (∀ x : A', B' x))
Even if A, A', B, B' live in a much smaller universe.
As I described above, it doesn't seem to be a way to move this equality back to a smaller universe.
So, if we wanted to keep the heterogeneous equality as a constant, it seems we would
have to support axiom schemas. That is, hpiext would be parametrized by the universes where
A, A', B and B'. Another possibility would be to have universe polymorphism like Agda.
None of the solutions seem attractive.
So, we decided to have heterogeneous equality as a special kind of expression.
And use the trick above to move equalities back to the right universe.
BTW, the parser is not creating the new heterogeneous equalities yet.
Moreover, kernel.lean still contains a constant name heq2 that is the heterogeneous
equality as a constant.
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
2014-02-07 18:07:08 +00:00
|
|
|
|
2014-04-17 18:31:48 +00:00
|
|
|
static unsigned dec(unsigned k) { return k == 0 ? 0 : k - 1; }
|
|
|
|
|
2014-04-17 17:52:07 +00:00
|
|
|
// Expr binders (Lambda, Pi)
|
2014-02-16 17:53:55 +00:00
|
|
|
expr_binder::expr_binder(expr_kind k, name const & n, expr const & t, expr const & b):
|
2014-02-20 18:07:38 +00:00
|
|
|
expr_composite(k, ::lean::hash(t.hash(), b.hash()),
|
2014-03-01 01:16:34 +00:00
|
|
|
t.has_metavar() || b.has_metavar(),
|
|
|
|
t.has_local() || b.has_local(),
|
|
|
|
t.has_param_univ() || b.has_param_univ(),
|
2014-04-17 18:31:48 +00:00
|
|
|
std::max(get_depth(t), get_depth(b)) + 1,
|
|
|
|
std::max(get_free_var_range(t), dec(get_free_var_range(b)))),
|
2013-07-22 11:03:46 +00:00
|
|
|
m_name(n),
|
2013-08-03 18:31:42 +00:00
|
|
|
m_domain(t),
|
2013-07-24 04:49:19 +00:00
|
|
|
m_body(b) {
|
2014-04-17 17:52:07 +00:00
|
|
|
lean_assert(k == expr_kind::Lambda || k == expr_kind::Pi);
|
2013-07-22 11:03:46 +00:00
|
|
|
}
|
2014-02-16 17:53:55 +00:00
|
|
|
void expr_binder::dealloc(buffer<expr_cell*> & todelete) {
|
2013-11-19 02:41:08 +00:00
|
|
|
dec_ref(m_body, todelete);
|
|
|
|
dec_ref(m_domain, todelete);
|
|
|
|
delete(this);
|
|
|
|
}
|
refactor(kernel): add heterogeneous equality back to expr
The main motivation is that we will be able to move equalities between universes.
For example, suppose we have
A : (Type i)
B : (Type i)
H : @eq (Type j) A B
where j > i
We didn't find any trick for deducing (@eq (Type i) A B) from H.
Before this commit, heterogeneous equality as a constant with type
heq : {A B : (Type U)} : A -> B -> Bool
So, from H, we would only be able to deduce
(@heq (Type j) (Type j) A B)
Not being able to move the equality back to a smaller universe is
problematic in several cases. I list some instances in the end of the commit message.
With this commit, Heterogeneous equality is a special kind of expression.
It is not a constant anymore. From H, we can deduce
H1 : A == B
That is, we are essentially "erasing" the universes when we move to heterogeneous equality.
Now, since A and B have (Type i), we can deduce (@eq (Type i) A B) from H1. The proof term is
(to_eq (Type i) A B (to_heq (Type j) A B H)) : (@eq (Type i) A B)
So, it remains to explain why we need this feature.
For example, suppose we want to state the Pi extensionality axiom.
axiom hpiext {A A' : (Type U)} {B : A → (Type U)} {B' : A' → (Type U)} :
A = A' → (∀ x x', x == x' → B x == B' x') → (∀ x, B x) == (∀ x, B' x)
This axiom produces an "inflated" equality at (Type U) when we treat heterogeneous
equality as a constant. The conclusion
(∀ x, B x) == (∀ x, B' x)
is syntax sugar for
(@heq (Type U) (Type U) (∀ x : A, B x) (∀ x : A', B' x))
Even if A, A', B, B' live in a much smaller universe.
As I described above, it doesn't seem to be a way to move this equality back to a smaller universe.
So, if we wanted to keep the heterogeneous equality as a constant, it seems we would
have to support axiom schemas. That is, hpiext would be parametrized by the universes where
A, A', B and B'. Another possibility would be to have universe polymorphism like Agda.
None of the solutions seem attractive.
So, we decided to have heterogeneous equality as a special kind of expression.
And use the trick above to move equalities back to the right universe.
BTW, the parser is not creating the new heterogeneous equalities yet.
Moreover, kernel.lean still contains a constant name heq2 that is the heterogeneous
equality as a constant.
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
2014-02-07 18:07:08 +00:00
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
// Expr Sort
|
|
|
|
expr_sort::expr_sort(level const & l):
|
2014-03-01 01:16:34 +00:00
|
|
|
expr_cell(expr_kind::Sort, ::lean::hash(l), has_meta(l), false, has_param(l)),
|
2013-07-30 02:44:26 +00:00
|
|
|
m_level(l) {
|
2013-07-22 11:03:46 +00:00
|
|
|
}
|
2014-02-16 17:53:55 +00:00
|
|
|
expr_sort::~expr_sort() {}
|
refactor(kernel): add heterogeneous equality back to expr
The main motivation is that we will be able to move equalities between universes.
For example, suppose we have
A : (Type i)
B : (Type i)
H : @eq (Type j) A B
where j > i
We didn't find any trick for deducing (@eq (Type i) A B) from H.
Before this commit, heterogeneous equality as a constant with type
heq : {A B : (Type U)} : A -> B -> Bool
So, from H, we would only be able to deduce
(@heq (Type j) (Type j) A B)
Not being able to move the equality back to a smaller universe is
problematic in several cases. I list some instances in the end of the commit message.
With this commit, Heterogeneous equality is a special kind of expression.
It is not a constant anymore. From H, we can deduce
H1 : A == B
That is, we are essentially "erasing" the universes when we move to heterogeneous equality.
Now, since A and B have (Type i), we can deduce (@eq (Type i) A B) from H1. The proof term is
(to_eq (Type i) A B (to_heq (Type j) A B H)) : (@eq (Type i) A B)
So, it remains to explain why we need this feature.
For example, suppose we want to state the Pi extensionality axiom.
axiom hpiext {A A' : (Type U)} {B : A → (Type U)} {B' : A' → (Type U)} :
A = A' → (∀ x x', x == x' → B x == B' x') → (∀ x, B x) == (∀ x, B' x)
This axiom produces an "inflated" equality at (Type U) when we treat heterogeneous
equality as a constant. The conclusion
(∀ x, B x) == (∀ x, B' x)
is syntax sugar for
(@heq (Type U) (Type U) (∀ x : A, B x) (∀ x : A', B' x))
Even if A, A', B, B' live in a much smaller universe.
As I described above, it doesn't seem to be a way to move this equality back to a smaller universe.
So, if we wanted to keep the heterogeneous equality as a constant, it seems we would
have to support axiom schemas. That is, hpiext would be parametrized by the universes where
A, A', B and B'. Another possibility would be to have universe polymorphism like Agda.
None of the solutions seem attractive.
So, we decided to have heterogeneous equality as a special kind of expression.
And use the trick above to move equalities back to the right universe.
BTW, the parser is not creating the new heterogeneous equalities yet.
Moreover, kernel.lean still contains a constant name heq2 that is the heterogeneous
equality as a constant.
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
2014-02-07 18:07:08 +00:00
|
|
|
|
|
|
|
// Expr Let
|
2014-02-19 17:48:28 +00:00
|
|
|
expr_let::expr_let(name const & n, expr const & t, expr const & v, expr const & b):
|
2014-02-20 18:07:38 +00:00
|
|
|
expr_composite(expr_kind::Let, ::lean::hash(v.hash(), b.hash()),
|
2014-03-01 01:16:34 +00:00
|
|
|
t.has_metavar() || v.has_metavar() || b.has_metavar(),
|
|
|
|
t.has_local() || v.has_local() || b.has_local(),
|
|
|
|
t.has_param_univ() || v.has_param_univ() || b.has_param_univ(),
|
2014-04-17 18:31:48 +00:00
|
|
|
std::max({get_depth(t), get_depth(v), get_depth(b)}) + 1,
|
|
|
|
std::max({get_free_var_range(t), dec(get_free_var_range(v)), dec(get_free_var_range(b))})),
|
2013-08-04 16:37:52 +00:00
|
|
|
m_name(n),
|
2013-09-06 17:06:26 +00:00
|
|
|
m_type(t),
|
2013-08-04 16:37:52 +00:00
|
|
|
m_value(v),
|
|
|
|
m_body(b) {
|
|
|
|
}
|
2013-11-19 02:41:08 +00:00
|
|
|
void expr_let::dealloc(buffer<expr_cell*> & todelete) {
|
|
|
|
dec_ref(m_body, todelete);
|
|
|
|
dec_ref(m_value, todelete);
|
|
|
|
dec_ref(m_type, todelete);
|
|
|
|
delete(this);
|
|
|
|
}
|
2013-09-04 06:15:37 +00:00
|
|
|
expr_let::~expr_let() {}
|
refactor(kernel): add heterogeneous equality back to expr
The main motivation is that we will be able to move equalities between universes.
For example, suppose we have
A : (Type i)
B : (Type i)
H : @eq (Type j) A B
where j > i
We didn't find any trick for deducing (@eq (Type i) A B) from H.
Before this commit, heterogeneous equality as a constant with type
heq : {A B : (Type U)} : A -> B -> Bool
So, from H, we would only be able to deduce
(@heq (Type j) (Type j) A B)
Not being able to move the equality back to a smaller universe is
problematic in several cases. I list some instances in the end of the commit message.
With this commit, Heterogeneous equality is a special kind of expression.
It is not a constant anymore. From H, we can deduce
H1 : A == B
That is, we are essentially "erasing" the universes when we move to heterogeneous equality.
Now, since A and B have (Type i), we can deduce (@eq (Type i) A B) from H1. The proof term is
(to_eq (Type i) A B (to_heq (Type j) A B H)) : (@eq (Type i) A B)
So, it remains to explain why we need this feature.
For example, suppose we want to state the Pi extensionality axiom.
axiom hpiext {A A' : (Type U)} {B : A → (Type U)} {B' : A' → (Type U)} :
A = A' → (∀ x x', x == x' → B x == B' x') → (∀ x, B x) == (∀ x, B' x)
This axiom produces an "inflated" equality at (Type U) when we treat heterogeneous
equality as a constant. The conclusion
(∀ x, B x) == (∀ x, B' x)
is syntax sugar for
(@heq (Type U) (Type U) (∀ x : A, B x) (∀ x : A', B' x))
Even if A, A', B, B' live in a much smaller universe.
As I described above, it doesn't seem to be a way to move this equality back to a smaller universe.
So, if we wanted to keep the heterogeneous equality as a constant, it seems we would
have to support axiom schemas. That is, hpiext would be parametrized by the universes where
A, A', B and B'. Another possibility would be to have universe polymorphism like Agda.
None of the solutions seem attractive.
So, we decided to have heterogeneous equality as a special kind of expression.
And use the trick above to move equalities back to the right universe.
BTW, the parser is not creating the new heterogeneous equalities yet.
Moreover, kernel.lean still contains a constant name heq2 that is the heterogeneous
equality as a constant.
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
2014-02-07 18:07:08 +00:00
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
// Macro attachment
|
|
|
|
int macro::push_lua(lua_State *) const { return 0; } // NOLINT
|
|
|
|
void macro::display(std::ostream & out) const { out << get_name(); }
|
|
|
|
bool macro::operator==(macro const & other) const { return typeid(*this) == typeid(other); }
|
|
|
|
bool macro::operator<(macro const & other) const {
|
2013-09-24 19:16:32 +00:00
|
|
|
if (get_name() == other.get_name())
|
|
|
|
return lt(other);
|
|
|
|
else
|
|
|
|
return get_name() < other.get_name();
|
|
|
|
}
|
2014-02-16 17:53:55 +00:00
|
|
|
format macro::pp(formatter const &, options const &) const { return format(get_name()); }
|
|
|
|
bool macro::is_atomic_pp(bool, bool) const { return true; }
|
|
|
|
unsigned macro::hash() const { return get_name().hash(); }
|
|
|
|
|
|
|
|
typedef std::unordered_map<std::string, macro::reader> macro_readers;
|
|
|
|
static std::unique_ptr<macro_readers> g_macro_readers;
|
|
|
|
macro_readers & get_macro_readers() {
|
|
|
|
if (!g_macro_readers)
|
|
|
|
g_macro_readers.reset(new macro_readers());
|
|
|
|
return *(g_macro_readers.get());
|
2013-12-28 09:16:50 +00:00
|
|
|
}
|
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
void macro::register_deserializer(std::string const & k, macro::reader rd) {
|
|
|
|
macro_readers & readers = get_macro_readers();
|
2013-12-28 09:16:50 +00:00
|
|
|
lean_assert(readers.find(k) == readers.end());
|
|
|
|
readers[k] = rd;
|
|
|
|
}
|
2014-02-16 17:53:55 +00:00
|
|
|
static expr read_macro(deserializer & d) {
|
2013-12-28 09:16:50 +00:00
|
|
|
auto k = d.read_string();
|
2014-02-16 17:53:55 +00:00
|
|
|
macro_readers & readers = get_macro_readers();
|
2013-12-28 09:16:50 +00:00
|
|
|
auto it = readers.find(k);
|
|
|
|
lean_assert(it != readers.end());
|
|
|
|
return it->second(d);
|
|
|
|
}
|
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
expr_macro::expr_macro(macro * m):
|
2014-03-01 01:16:34 +00:00
|
|
|
expr_cell(expr_kind::Macro, m->hash(), false, false, false),
|
2014-02-16 17:53:55 +00:00
|
|
|
m_macro(m) {
|
|
|
|
m_macro->inc_ref();
|
|
|
|
}
|
|
|
|
expr_macro::~expr_macro() {
|
|
|
|
m_macro->dec_ref();
|
|
|
|
}
|
refactor(kernel): add heterogeneous equality back to expr
The main motivation is that we will be able to move equalities between universes.
For example, suppose we have
A : (Type i)
B : (Type i)
H : @eq (Type j) A B
where j > i
We didn't find any trick for deducing (@eq (Type i) A B) from H.
Before this commit, heterogeneous equality as a constant with type
heq : {A B : (Type U)} : A -> B -> Bool
So, from H, we would only be able to deduce
(@heq (Type j) (Type j) A B)
Not being able to move the equality back to a smaller universe is
problematic in several cases. I list some instances in the end of the commit message.
With this commit, Heterogeneous equality is a special kind of expression.
It is not a constant anymore. From H, we can deduce
H1 : A == B
That is, we are essentially "erasing" the universes when we move to heterogeneous equality.
Now, since A and B have (Type i), we can deduce (@eq (Type i) A B) from H1. The proof term is
(to_eq (Type i) A B (to_heq (Type j) A B H)) : (@eq (Type i) A B)
So, it remains to explain why we need this feature.
For example, suppose we want to state the Pi extensionality axiom.
axiom hpiext {A A' : (Type U)} {B : A → (Type U)} {B' : A' → (Type U)} :
A = A' → (∀ x x', x == x' → B x == B' x') → (∀ x, B x) == (∀ x, B' x)
This axiom produces an "inflated" equality at (Type U) when we treat heterogeneous
equality as a constant. The conclusion
(∀ x, B x) == (∀ x, B' x)
is syntax sugar for
(@heq (Type U) (Type U) (∀ x : A, B x) (∀ x : A', B' x))
Even if A, A', B, B' live in a much smaller universe.
As I described above, it doesn't seem to be a way to move this equality back to a smaller universe.
So, if we wanted to keep the heterogeneous equality as a constant, it seems we would
have to support axiom schemas. That is, hpiext would be parametrized by the universes where
A, A', B and B'. Another possibility would be to have universe polymorphism like Agda.
None of the solutions seem attractive.
So, we decided to have heterogeneous equality as a special kind of expression.
And use the trick above to move equalities back to the right universe.
BTW, the parser is not creating the new heterogeneous equalities yet.
Moreover, kernel.lean still contains a constant name heq2 that is the heterogeneous
equality as a constant.
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
2014-02-07 18:07:08 +00:00
|
|
|
|
2013-07-22 11:03:46 +00:00
|
|
|
void expr_cell::dealloc() {
|
2013-11-19 02:41:08 +00:00
|
|
|
try {
|
|
|
|
buffer<expr_cell*> todo;
|
|
|
|
todo.push_back(this);
|
|
|
|
while (!todo.empty()) {
|
|
|
|
expr_cell * it = todo.back();
|
|
|
|
todo.pop_back();
|
|
|
|
lean_assert(it->get_rc() == 0);
|
|
|
|
switch (it->kind()) {
|
|
|
|
case expr_kind::Var: delete static_cast<expr_var*>(it); break;
|
2014-02-16 17:53:55 +00:00
|
|
|
case expr_kind::Macro: delete static_cast<expr_macro*>(it); break;
|
|
|
|
case expr_kind::Meta:
|
|
|
|
case expr_kind::Local: static_cast<expr_mlocal*>(it)->dealloc(todo); break;
|
|
|
|
case expr_kind::Constant: delete static_cast<expr_const*>(it); break;
|
|
|
|
case expr_kind::Sort: delete static_cast<expr_sort*>(it); break;
|
2013-11-19 02:41:08 +00:00
|
|
|
case expr_kind::App: static_cast<expr_app*>(it)->dealloc(todo); break;
|
2014-02-16 17:53:55 +00:00
|
|
|
case expr_kind::Lambda:
|
2014-04-17 17:52:07 +00:00
|
|
|
case expr_kind::Pi: static_cast<expr_binder*>(it)->dealloc(todo); break;
|
2013-11-19 02:41:08 +00:00
|
|
|
case expr_kind::Let: static_cast<expr_let*>(it)->dealloc(todo); break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
} catch (std::bad_alloc&) {
|
|
|
|
// We need this catch, because push_back may fail when expanding the buffer.
|
|
|
|
// In this case, we avoid the crash, and "accept" the memory leak.
|
2013-07-22 11:03:46 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
// Auxiliary constructors
|
2014-02-22 19:44:57 +00:00
|
|
|
expr mk_app(expr const & f, unsigned num_args, expr const * args) {
|
|
|
|
expr r = f;
|
|
|
|
for (unsigned i = 0; i < num_args; i++)
|
|
|
|
r = mk_app(r, args[i]);
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
expr mk_app(unsigned num_args, expr const * args) {
|
|
|
|
lean_assert(num_args >= 2);
|
2014-02-22 19:44:57 +00:00
|
|
|
return mk_app(mk_app(args[0], args[1]), num_args - 2, args+2);
|
|
|
|
}
|
|
|
|
|
|
|
|
expr mk_rev_app(expr const & f, unsigned num_args, expr const * args) {
|
|
|
|
expr r = f;
|
|
|
|
unsigned i = num_args;
|
|
|
|
while (i > 0) {
|
|
|
|
--i;
|
2014-02-16 17:53:55 +00:00
|
|
|
r = mk_app(r, args[i]);
|
2014-02-22 19:44:57 +00:00
|
|
|
}
|
2013-08-04 02:57:06 +00:00
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2014-02-22 19:44:57 +00:00
|
|
|
expr mk_rev_app(unsigned num_args, expr const * args) {
|
|
|
|
lean_assert(num_args >= 2);
|
|
|
|
return mk_rev_app(mk_app(args[num_args-1], args[num_args-2]), num_args-2, args);
|
|
|
|
}
|
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
static name g_default_var_name("a");
|
|
|
|
bool is_default_var_name(name const & n) { return n == g_default_var_name; }
|
|
|
|
expr mk_arrow(expr const & t, expr const & e) { return mk_pi(g_default_var_name, t, e); }
|
|
|
|
|
|
|
|
expr Bool = mk_sort(mk_level_zero());
|
|
|
|
expr Type = mk_sort(mk_level_one());
|
|
|
|
expr mk_Bool() { return Bool; }
|
|
|
|
expr mk_Type() { return Type; }
|
|
|
|
|
|
|
|
unsigned get_depth(expr const & e) {
|
|
|
|
switch (e.kind()) {
|
|
|
|
case expr_kind::Var: case expr_kind::Constant: case expr_kind::Sort:
|
|
|
|
case expr_kind::Meta: case expr_kind::Local: case expr_kind::Macro:
|
|
|
|
return 1;
|
2014-04-17 17:52:07 +00:00
|
|
|
case expr_kind::Lambda: case expr_kind::Pi:
|
2014-02-16 17:53:55 +00:00
|
|
|
case expr_kind::App: case expr_kind::Let:
|
|
|
|
return static_cast<expr_composite*>(e.raw())->m_depth;
|
|
|
|
}
|
|
|
|
lean_unreachable(); // LCOV_EXCL_LINE
|
2013-07-22 11:03:46 +00:00
|
|
|
}
|
|
|
|
|
2014-04-17 18:31:48 +00:00
|
|
|
unsigned get_free_var_range(expr const & e) {
|
|
|
|
switch (e.kind()) {
|
|
|
|
case expr_kind::Var:
|
|
|
|
return var_idx(e) + 1;
|
|
|
|
case expr_kind::Constant: case expr_kind::Sort: case expr_kind::Macro:
|
|
|
|
return 0;
|
|
|
|
case expr_kind::Meta: case expr_kind::Local:
|
|
|
|
return get_free_var_range(mlocal_type(e));
|
|
|
|
case expr_kind::Lambda: case expr_kind::Pi:
|
|
|
|
case expr_kind::App: case expr_kind::Let:
|
|
|
|
return static_cast<expr_composite*>(e.raw())->m_free_var_range;
|
|
|
|
}
|
|
|
|
lean_unreachable(); // LCOV_EXCL_LINE
|
|
|
|
}
|
|
|
|
|
2014-02-16 17:53:55 +00:00
|
|
|
bool operator==(expr const & a, expr const & b) { return expr_eq_fn()(a, b); }
|
|
|
|
|
2014-02-17 23:21:48 +00:00
|
|
|
expr update_app(expr const & e, expr const & new_fn, expr const & new_arg) {
|
|
|
|
if (!is_eqp(app_fn(e), new_fn) || !is_eqp(app_arg(e), new_arg))
|
|
|
|
return mk_app(new_fn, new_arg);
|
|
|
|
else
|
|
|
|
return e;
|
|
|
|
}
|
|
|
|
|
2014-02-22 19:44:57 +00:00
|
|
|
expr update_rev_app(expr const & e, unsigned num, expr const * new_args) {
|
|
|
|
expr const * it = &e;
|
|
|
|
for (unsigned i = 0; i < num - 1; i++) {
|
|
|
|
if (!is_app(*it) || !is_eqp(app_arg(*it), new_args[i]))
|
|
|
|
return mk_rev_app(num, new_args);
|
|
|
|
it = &app_fn(*it);
|
|
|
|
}
|
|
|
|
if (!is_eqp(*it, new_args[num - 1]))
|
|
|
|
return mk_rev_app(num, new_args);
|
|
|
|
return e;
|
|
|
|
}
|
|
|
|
|
2014-02-17 23:21:48 +00:00
|
|
|
expr update_binder(expr const & e, expr const & new_domain, expr const & new_body) {
|
|
|
|
if (!is_eqp(binder_domain(e), new_domain) || !is_eqp(binder_body(e), new_body))
|
|
|
|
return mk_binder(e.kind(), binder_name(e), new_domain, new_body);
|
|
|
|
else
|
|
|
|
return e;
|
|
|
|
}
|
|
|
|
|
2014-02-19 17:48:28 +00:00
|
|
|
expr update_let(expr const & e, expr const & new_type, expr const & new_val, expr const & new_body) {
|
2014-02-17 23:21:48 +00:00
|
|
|
if (!is_eqp(let_type(e), new_type) || !is_eqp(let_value(e), new_val) || !is_eqp(let_body(e), new_body))
|
|
|
|
return mk_let(let_name(e), new_type, new_val, new_body);
|
|
|
|
else
|
|
|
|
return e;
|
|
|
|
}
|
2014-02-16 17:53:55 +00:00
|
|
|
|
2014-02-17 23:21:48 +00:00
|
|
|
expr update_mlocal(expr const & e, expr const & new_type) {
|
|
|
|
if (!is_eqp(mlocal_type(e), new_type))
|
|
|
|
return mk_mlocal(is_metavar(e), mlocal_name(e), new_type);
|
|
|
|
else
|
|
|
|
return e;
|
|
|
|
}
|
|
|
|
|
2014-02-25 02:31:38 +00:00
|
|
|
expr update_sort(expr const & e, level const & new_level) {
|
|
|
|
if (!is_eqp(sort_level(e), new_level))
|
|
|
|
return mk_sort(new_level);
|
|
|
|
else
|
|
|
|
return e;
|
|
|
|
}
|
|
|
|
|
|
|
|
expr update_constant(expr const & e, levels const & new_levels) {
|
|
|
|
if (!is_eqp(const_level_params(e), new_levels))
|
|
|
|
return mk_constant(const_name(e), new_levels);
|
|
|
|
else
|
|
|
|
return e;
|
|
|
|
}
|
|
|
|
|
2014-02-18 00:10:11 +00:00
|
|
|
bool is_atomic(expr const & e) {
|
|
|
|
switch (e.kind()) {
|
|
|
|
case expr_kind::Constant: case expr_kind::Sort:
|
|
|
|
case expr_kind::Macro: case expr_kind::Var:
|
|
|
|
return true;
|
|
|
|
case expr_kind::App: case expr_kind::Let:
|
|
|
|
case expr_kind::Meta: case expr_kind::Local:
|
2014-04-17 17:52:07 +00:00
|
|
|
case expr_kind::Lambda: case expr_kind::Pi:
|
2014-02-18 00:10:11 +00:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
lean_unreachable(); // LCOV_EXCL_LINE
|
|
|
|
}
|
2014-02-16 17:53:55 +00:00
|
|
|
|
2013-08-02 04:28:26 +00:00
|
|
|
bool is_arrow(expr const & t) {
|
2013-12-21 21:59:45 +00:00
|
|
|
optional<bool> r = t.raw()->is_arrow();
|
|
|
|
if (r) {
|
|
|
|
return *r;
|
|
|
|
} else {
|
2014-02-18 00:10:11 +00:00
|
|
|
bool res = is_pi(t) && !has_free_var(binder_body(t), 0);
|
2013-12-21 21:59:45 +00:00
|
|
|
t.raw()->set_is_arrow(res);
|
|
|
|
return res;
|
|
|
|
}
|
2013-08-02 04:28:26 +00:00
|
|
|
}
|
|
|
|
|
2013-07-24 17:14:22 +00:00
|
|
|
expr copy(expr const & a) {
|
|
|
|
switch (a.kind()) {
|
2013-08-06 18:27:14 +00:00
|
|
|
case expr_kind::Var: return mk_var(var_idx(a));
|
2014-02-18 01:14:47 +00:00
|
|
|
case expr_kind::Constant: return mk_constant(const_name(a), const_level_params(a));
|
|
|
|
case expr_kind::Sort: return mk_sort(sort_level(a));
|
|
|
|
case expr_kind::Macro: return mk_macro(static_cast<expr_macro*>(a.raw())->m_macro);
|
|
|
|
case expr_kind::App: return mk_app(app_fn(a), app_arg(a));
|
|
|
|
case expr_kind::Lambda: return mk_lambda(binder_name(a), binder_domain(a), binder_body(a));
|
|
|
|
case expr_kind::Pi: return mk_pi(binder_name(a), binder_domain(a), binder_body(a));
|
2013-09-06 17:06:26 +00:00
|
|
|
case expr_kind::Let: return mk_let(let_name(a), let_type(a), let_value(a), let_body(a));
|
2014-02-18 01:14:47 +00:00
|
|
|
case expr_kind::Meta: return mk_metavar(mlocal_name(a), mlocal_type(a));
|
|
|
|
case expr_kind::Local: return mk_local(mlocal_name(a), mlocal_type(a));
|
2013-07-24 17:14:22 +00:00
|
|
|
}
|
2013-11-11 17:19:38 +00:00
|
|
|
lean_unreachable(); // LCOV_EXCL_LINE
|
2013-07-24 17:14:22 +00:00
|
|
|
}
|
2013-12-28 09:16:50 +00:00
|
|
|
|
|
|
|
class expr_serializer : public object_serializer<expr, expr_hash_alloc, expr_eqp> {
|
|
|
|
typedef object_serializer<expr, expr_hash_alloc, expr_eqp> super;
|
2014-01-03 04:03:42 +00:00
|
|
|
max_sharing_fn m_max_sharing_fn;
|
|
|
|
|
|
|
|
void write_core(expr const & a) {
|
2013-12-30 03:59:53 +00:00
|
|
|
auto k = a.kind();
|
2014-02-18 05:32:24 +00:00
|
|
|
super::write_core(a, static_cast<char>(k), [&]() {
|
2013-12-28 09:16:50 +00:00
|
|
|
serializer & s = get_owner();
|
|
|
|
switch (k) {
|
2014-02-18 05:32:24 +00:00
|
|
|
case expr_kind::Var:
|
|
|
|
s << var_idx(a);
|
|
|
|
break;
|
|
|
|
case expr_kind::Constant:
|
|
|
|
s << const_name(a) << const_level_params(a);
|
|
|
|
break;
|
|
|
|
case expr_kind::Sort:
|
|
|
|
s << sort_level(a);
|
|
|
|
break;
|
|
|
|
case expr_kind::Macro:
|
|
|
|
to_macro(a).write(s);
|
|
|
|
break;
|
2013-12-28 09:16:50 +00:00
|
|
|
case expr_kind::App:
|
2014-02-18 05:32:24 +00:00
|
|
|
write_core(app_fn(a)); write_core(app_arg(a));
|
|
|
|
break;
|
2014-04-17 17:52:07 +00:00
|
|
|
case expr_kind::Lambda: case expr_kind::Pi:
|
2014-02-18 05:32:24 +00:00
|
|
|
s << binder_name(a); write_core(binder_domain(a)); write_core(binder_body(a));
|
|
|
|
break;
|
|
|
|
case expr_kind::Let:
|
|
|
|
s << let_name(a); write_core(let_type(a)); write_core(let_value(a)); write_core(let_body(a));
|
|
|
|
break;
|
|
|
|
case expr_kind::Meta: case expr_kind::Local:
|
|
|
|
s << mlocal_name(a); write_core(mlocal_type(a));
|
2013-12-28 09:16:50 +00:00
|
|
|
break;
|
|
|
|
}
|
|
|
|
});
|
|
|
|
}
|
2014-01-03 04:03:42 +00:00
|
|
|
public:
|
|
|
|
void write(expr const & a) {
|
|
|
|
write_core(m_max_sharing_fn(a));
|
|
|
|
}
|
2013-12-28 09:16:50 +00:00
|
|
|
};
|
|
|
|
|
|
|
|
class expr_deserializer : public object_deserializer<expr> {
|
|
|
|
typedef object_deserializer<expr> super;
|
|
|
|
public:
|
2014-02-18 05:32:24 +00:00
|
|
|
expr read_binder(expr_kind k) {
|
|
|
|
deserializer & d = get_owner();
|
|
|
|
name n = read_name(d);
|
|
|
|
expr t = read();
|
|
|
|
return mk_binder(k, n, t, read());
|
|
|
|
}
|
|
|
|
|
2013-12-28 09:16:50 +00:00
|
|
|
expr read() {
|
2013-12-30 03:59:53 +00:00
|
|
|
return super::read_core([&](char c) {
|
2013-12-28 09:16:50 +00:00
|
|
|
deserializer & d = get_owner();
|
2013-12-30 03:11:57 +00:00
|
|
|
auto k = static_cast<expr_kind>(c);
|
2013-12-28 09:16:50 +00:00
|
|
|
switch (k) {
|
|
|
|
case expr_kind::Var:
|
|
|
|
return mk_var(d.read_unsigned());
|
|
|
|
case expr_kind::Constant: {
|
|
|
|
auto n = read_name(d);
|
2014-02-18 05:32:24 +00:00
|
|
|
return mk_constant(n, read_levels(d));
|
2013-12-28 09:16:50 +00:00
|
|
|
}
|
2014-02-18 05:32:24 +00:00
|
|
|
case expr_kind::Sort:
|
|
|
|
return mk_sort(read_level(d));
|
2013-12-28 09:16:50 +00:00
|
|
|
break;
|
2014-02-18 05:32:24 +00:00
|
|
|
case expr_kind::Macro:
|
|
|
|
return read_macro(d);
|
2013-12-28 09:16:50 +00:00
|
|
|
case expr_kind::App: {
|
2014-02-18 05:32:24 +00:00
|
|
|
expr f = read();
|
|
|
|
return mk_app(f, read());
|
2014-02-04 00:52:49 +00:00
|
|
|
}
|
2014-04-17 17:52:07 +00:00
|
|
|
case expr_kind::Lambda: case expr_kind::Pi:
|
2014-02-18 05:32:24 +00:00
|
|
|
return read_binder(k);
|
2013-12-28 09:16:50 +00:00
|
|
|
case expr_kind::Let: {
|
|
|
|
name n = read_name(d);
|
2014-02-19 17:48:28 +00:00
|
|
|
expr t = read();
|
2013-12-28 09:16:50 +00:00
|
|
|
expr v = read();
|
|
|
|
return mk_let(n, t, v, read());
|
|
|
|
}
|
2014-02-18 05:32:24 +00:00
|
|
|
case expr_kind::Meta: {
|
|
|
|
name n = read_name(d);
|
|
|
|
return mk_metavar(n, read());
|
|
|
|
}
|
|
|
|
case expr_kind::Local: {
|
2013-12-28 09:16:50 +00:00
|
|
|
name n = read_name(d);
|
2014-02-18 05:32:24 +00:00
|
|
|
return mk_local(n, read());
|
2013-12-28 09:16:50 +00:00
|
|
|
}}
|
2014-01-16 01:09:04 +00:00
|
|
|
throw_corrupted_file(); // LCOV_EXCL_LINE
|
2013-12-28 09:16:50 +00:00
|
|
|
});
|
|
|
|
}
|
|
|
|
};
|
|
|
|
|
|
|
|
struct expr_sd {
|
|
|
|
unsigned m_s_extid;
|
|
|
|
unsigned m_d_extid;
|
|
|
|
expr_sd() {
|
|
|
|
m_s_extid = serializer::register_extension([](){ return std::unique_ptr<serializer::extension>(new expr_serializer()); });
|
|
|
|
m_d_extid = deserializer::register_extension([](){ return std::unique_ptr<deserializer::extension>(new expr_deserializer()); });
|
|
|
|
}
|
|
|
|
};
|
|
|
|
static expr_sd g_expr_sd;
|
|
|
|
|
|
|
|
serializer & operator<<(serializer & s, expr const & n) {
|
|
|
|
s.get_extension<expr_serializer>(g_expr_sd.m_s_extid).write(n);
|
|
|
|
return s;
|
|
|
|
}
|
|
|
|
|
|
|
|
expr read_expr(deserializer & d) {
|
|
|
|
return d.get_extension<expr_deserializer>(g_expr_sd.m_d_extid).read();
|
|
|
|
}
|
2013-07-22 11:03:46 +00:00
|
|
|
}
|