lean4-htt/src/library/metavar_context.cpp

/*
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Author: Leonardo de Moura
*/
#include "util/fresh_name.h"
#include "kernel/for_each_fn.h"
#include "library/metavar_util.h"
#include "library/metavar_context.h"

namespace lean {
static name *       g_meta_prefix;
static expr *       g_dummy_type;

name mk_meta_decl_name() {
    return mk_tagged_fresh_name(*g_meta_prefix);
}

expr mk_meta_ref(name const & n) {
    return mk_metavar(n, *g_dummy_type);
}

bool is_metavar_decl_ref(level const & u) {
    return is_meta(u) && is_tagged_by(meta_id(u), *g_meta_prefix);
}

bool is_metavar_decl_ref(expr const & e) {
    return is_metavar(e) && mlocal_type(e) == *g_dummy_type;
}

level metavar_context::mk_univ_metavar_decl() {
    return mk_meta_univ(mk_meta_decl_name());
}

expr metavar_context::mk_metavar_decl(local_context const & ctx, expr const & type) {
    name n = mk_meta_decl_name();
    m_decls.insert(n, metavar_decl(ctx, type));
    return mk_meta_ref(n);
}

optional<metavar_decl> metavar_context::get_metavar_decl(expr const & e) const {
    lean_assert(is_metavar_decl_ref(e));
    if (auto r = m_decls.find(mlocal_name(e)))
        return optional<metavar_decl>(*r);
    else
        return optional<metavar_decl>();
}

void metavar_context::assign(level const & u, level const & l) {
    lean_assert(!is_assigned(u));
    m_uassignment.insert(meta_id(u), l);
}

void metavar_context::assign(expr const & e, expr const & v) {
    lean_assert(!is_assigned(e));
    m_eassignment.insert(mlocal_name(e), v);
}

optional<level> metavar_context::get_assignment(level const & l) const {
    lean_assert(is_metavar_decl_ref(l));
    if (auto v = m_uassignment.find(meta_id(l)))
        return some_level(*v);
    else
        return none_level();
}

optional<expr> metavar_context::get_assignment(expr const & e) const {
    lean_assert(is_metavar_decl_ref(e));
    if (auto v = m_eassignment.find(mlocal_name(e)))
        return some_expr(*v);
    else
        return none_expr();
}

struct metavar_context::interface_impl {
    metavar_context & m_ctx;
    interface_impl(metavar_context const & ctx):m_ctx(const_cast<metavar_context&>(ctx)) {}

    static bool is_mvar(level const & l) { return is_metavar_decl_ref(l); }
    bool is_assigned(level const & l) const { return m_ctx.is_assigned(l); }
    optional<level> get_assignment(level const & l) const { return m_ctx.get_assignment(l); }
    void assign(level const & u, level const & v) { m_ctx.assign(u, v); }

    static bool is_mvar(expr const & e) { return is_metavar_decl_ref(e); }
    bool is_assigned(expr const & e) const { return m_ctx.is_assigned(e); }
    optional<expr> get_assignment(expr const & e) const { return m_ctx.get_assignment(e); }
    void assign(expr const & m, expr const & v) { m_ctx.assign(m, v); }
};


bool metavar_context::has_assigned(level const & l) const {
    return ::lean::has_assigned(interface_impl(*this), l);
}

bool metavar_context::has_assigned(expr const & e) const {
    return ::lean::has_assigned(interface_impl(*this), e);
}

level metavar_context::instantiate(level const & l) {
    interface_impl impl(*this);
    return ::lean::instantiate(impl, l);
}

expr metavar_context::instantiate(expr const & e) {
    interface_impl impl(*this);
    return ::lean::instantiate(impl, e);
}

template<typename C>
static bool well_formed_metavar_occs(expr const & e, C const & ds, metavar_context const & ctx) {
    bool ok = true;
    for_each(e, [&](expr const & e, unsigned) {
            if (!ok) return false;
            if (!has_expr_metavar(e)) return false;
            if (is_metavar_decl_ref(e)) {
                if (auto d = ctx.get_metavar_decl(e)) {
                    if (!d->get_context().is_subset_of(ds)) {
                        /* invalid metavariable context */
                        ok = false;
                        return false;
                    }
                } else {
                    /* undefined metavariable */
                    ok = false;
                    return false;
                }
            }
            return true;
        });
    return ok;
}

bool metavar_context::well_formed(local_context const & ctx) const {
    bool ok = true;
    name_set visited;
    ctx.for_each([&](local_decl const & d) {
            if (!well_formed_metavar_occs(d.get_type(), visited, *this)) {
                ok = false;
                lean_unreachable();
            }
            if (auto v = d.get_value()) {
                if (!well_formed_metavar_occs(*v, visited, *this)) {
                    ok = false;
                    lean_unreachable();
                }
            }
            visited.insert(d.get_name());
        });
    return ok;
}

bool metavar_context::well_formed(local_context const & ctx, expr const & e) const {
    return well_formed_metavar_occs(e, ctx, *this);
}

bool well_formed(local_context const & lctx, metavar_context const & mctx) {
    if (!lctx.well_formed()) {
        lean_unreachable();
        return false;
    }
    if (!mctx.well_formed(lctx)) {
        lean_unreachable();
        return false;
    }
    return true;
}

bool well_formed(local_context const & lctx, metavar_context const & mctx, expr const & e) {
    if (!lctx.well_formed(e)) {
        lean_unreachable();
        return false;
    }
    if (!mctx.well_formed(lctx, e)) {
        lean_unreachable();
        return false;
    }
    return true;
}

void initialize_metavar_context() {
    g_meta_prefix = new name(name::mk_internal_unique_name());
    g_dummy_type  = new expr(mk_constant(name::mk_internal_unique_name()));
}

void finalize_metavar_context() {
    delete g_meta_prefix;
    delete g_dummy_type;
}
}