/*
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 "library/fun_info.h"
#include "library/vm/vm_list.h"
#include "library/vm/vm_expr.h"
#include "library/vm/vm_nat.h"
#include "library/vm/vm_option.h"
#include "library/tactic/tactic_state.h"

namespace lean {
inline vm_obj bb(bool b) { return mk_vm_bool(b); }
/*
  structure param_info :=
  (is_implicit : bool)
  (is_inst_implicit : bool)
  (is_prop : bool)
  (has_fwd_deps : bool)
  (back_deps : list nat) -- previous parameters it depends on
*/
vm_obj to_obj(param_info const & info) {
    vm_obj args[5] = { bb(info.is_implicit()), bb(info.is_inst_implicit()),
                       bb(info.is_prop()), bb(info.has_fwd_deps()),
                       to_obj(info.get_back_deps()) };
    return mk_vm_constructor(0, 5, args);
}

vm_obj to_obj(list<param_info> const & ls) {
    return to_vm_list(ls, [&](param_info const & p) { return to_obj(p); });
}

/*
structure fun_info :=
(params      : list param_info)
(result_deps : list nat) -- parameters the result type depends on
*/
vm_obj to_obj(fun_info const & info) {
    return mk_vm_constructor(0, to_obj(info.get_params_info()), to_obj(info.get_result_deps()));
}

vm_obj to_obj(ss_param_info const & info) {
    return mk_vm_constructor(0, bb(info.specialized()), bb(info.is_subsingleton()));
}

vm_obj to_obj(list<ss_param_info> const & ls) {
    return to_vm_list(ls, [&](ss_param_info const & p) { return to_obj(p); });
}

#define TRY   LEAN_TACTIC_TRY
#define CATCH LEAN_TACTIC_CATCH(to_tactic_state(s))

static vm_obj mk_result(fun_info const & info, vm_obj const & s) {
    return mk_tactic_success(to_obj(info), to_tactic_state(s));
}

static vm_obj mk_result(list<ss_param_info> const & info, vm_obj const & s) {
    return mk_tactic_success(to_obj(info), to_tactic_state(s));
}

vm_obj tactic_get_fun_info(vm_obj const & fn, vm_obj const & n, vm_obj const & m, vm_obj const & s) {
    TRY;
    type_context ctx = mk_type_context_for(s, m);
    if (is_none(n)) {
        return mk_result(get_fun_info(ctx, to_expr(fn)), s);
    } else {
        return mk_result(get_fun_info(ctx, to_expr(fn), force_to_unsigned(get_some_value(n), 0)), s);
    }
    CATCH;
}

vm_obj tactic_get_subsingleton_info(vm_obj const & fn, vm_obj const & n, vm_obj const & m, vm_obj const & s) {
    TRY;
    type_context ctx = mk_type_context_for(s, m);
    if (is_none(n)) {
        return mk_result(get_subsingleton_info(ctx, to_expr(fn)), s);
    } else {
        return mk_result(get_subsingleton_info(ctx, to_expr(fn), force_to_unsigned(get_some_value(n), 0)), s);
    }
    CATCH;
}

vm_obj tactic_get_spec_subsingleton_info(vm_obj const & app, vm_obj const & m, vm_obj const & s) {
    TRY;
    type_context ctx = mk_type_context_for(s, m);
    return mk_result(get_specialized_subsingleton_info(ctx, to_expr(app)), s);
    CATCH;
}

vm_obj tactic_get_spec_prefix_size(vm_obj const & fn, vm_obj const & n, vm_obj const & m, vm_obj const & s) {
    TRY;
    type_context ctx = mk_type_context_for(s, m);
    return mk_tactic_success(mk_vm_nat(get_specialization_prefix_size(ctx, to_expr(fn), force_to_unsigned(n, 0))),
                             to_tactic_state(s));
    CATCH;
}

void initialize_fun_info_tactics() {
    DECLARE_VM_BUILTIN(name({"tactic", "get_fun_info"}),               tactic_get_fun_info);
    DECLARE_VM_BUILTIN(name({"tactic", "get_subsingleton_info"}),      tactic_get_subsingleton_info);
    DECLARE_VM_BUILTIN(name({"tactic", "get_spec_subsingleton_info"}), tactic_get_spec_subsingleton_info);
    DECLARE_VM_BUILTIN(name({"tactic", "get_spec_prefix_size"}),       tactic_get_spec_prefix_size);
}

void finalize_fun_info_tactics() {
}
}