lean2/src/kernel/update_expr.cpp

/*
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 "util/buffer.h"
#include "kernel/update_expr.h"

namespace lean {
expr update_app(expr const & app, unsigned i, expr const & new_arg) {
    if (is_eqp(arg(app, i), new_arg)) {
        return app;
    } else {
        buffer<expr> new_args;
        unsigned num = num_args(app);
        for (unsigned j = 0; j < num; j++) {
            if (i == j)
                new_args.push_back(new_arg);
            else
                new_args.push_back(arg(app, j));
        }
        return mk_app(new_args);
    }
}

expr update_app(expr const & app, unsigned num_new_args, expr const * new_args) {
    unsigned i;
    unsigned num = num_args(app);
    if (num != num_new_args)
        return mk_app(num_new_args, new_args);
    for (i = 0; i < num; i++) {
        if (!is_eqp(arg(app, i), new_args[i]))
            break;
    }
    if (i < num)
        return mk_app(num, new_args);
    else
        return app;
}

expr update_lambda(expr const & lambda, expr const & d, expr const & b) {
    if (is_eqp(abst_domain(lambda), d) && is_eqp(abst_body(lambda), b))
        return lambda;
    else
        return mk_lambda(abst_name(lambda), d, b);
}

expr update_pi(expr const & pi, expr const & d, expr const & b) {
    if (is_eqp(abst_domain(pi), d) && is_eqp(abst_body(pi), b))
        return pi;
    else
        return mk_pi(abst_name(pi), d, b);
}

expr update_sigma(expr const & sig, expr const & d, expr const & b) {
    if (is_eqp(abst_domain(sig), d) && is_eqp(abst_body(sig), b))
        return sig;
    else
        return mk_sigma(abst_name(sig), d, b);
}

expr update_abstraction(expr const & abst, expr const & d, expr const & b) {
    switch (abst.kind()) {
    case expr_kind::Lambda: return update_lambda(abst, d, b);
    case expr_kind::Pi:     return update_pi(abst, d, b);
    case expr_kind::Sigma:  return update_sigma(abst, d, b);
    default: lean_unreachable();
    }
}

expr update_let(expr const & let, optional<expr> const & t, expr const & v, expr const & b) {
    if (is_eqp(let_type(let), t) && is_eqp(let_value(let), v) && is_eqp(let_body(let), b))
        return let;
    else
        return mk_let(let_name(let), t, v, b);
}
}