#include <rlang.h>
#include "utils.h"
#include "internal.h"


r_obj* new_preserved_empty_list(void) {
  r_obj* empty_list = r_alloc_list(0);
  r_preserve(empty_list);
  r_mark_shared(empty_list);

  r_obj* nms = KEEP(r_alloc_character(0));
  r_attrib_poke_names(empty_list, nms);
  FREE(1);

  return empty_list;
}


/* For debugging with gdb or lldb. Exported as a C callable.
 * Usage with lldb:
 *
 * ```
 * // Full backtrace:
 * expr R_GetCCallable("rlang", "rlang_print_backtrace")(true)
 *
 * // Linear backtrace:
 * expr R_GetCCallable("rlang", "rlang_print_backtrace")(false)
 * ```
 */
void rlang_print_backtrace(bool full) {
  r_obj* env = KEEP(r_peek_frame());
  r_obj* trace = KEEP(r_parse_eval("rlang::trace_back()", env));

  const char* source = full ?
    "print(x, simplify = 'none')" :
    "print(x, simplify = 'branch')";
  r_obj* call = KEEP(r_parse(source));

  r_eval_with_x(call, trace, r_envs.base);

  FREE(3);
  return;
}

/* Print an environment in a debugging session.
 *
 * ```
 * expr R_GetCCallable("rlang", "rlang_env_print")(obj)
 * ```
 */
void rlang_env_print(r_obj* x) {
  r_obj* call = KEEP(r_parse("base::print(rlang::env_print(x))"));
  r_eval_with_x(call, x, r_envs.base);

  FREE(1);
  return;
}


static r_obj* deprecate_soft_call = NULL;
void deprecate_soft(const char* msg,
                            const char* id,
                            r_obj* env) {
  id = id ? id : msg;
  env = env ? env : r_envs.empty;
  if (!msg) {
    r_abort("Internal error: NULL `msg` in r_deprecate_soft()");
  }

  r_obj* msg_ = KEEP(r_chr(msg));
  r_obj* id_ = KEEP(r_chr(id));

  r_eval_with_xyz(deprecate_soft_call, msg_, id_, env, r_envs.base);

  FREE(2);
}

#define BUFSIZE 8192
#define INTERP(BUF, FMT, DOTS)                  \
  {                                             \
    va_list dots;                               \
    va_start(dots, FMT);                        \
    vsnprintf(BUF, BUFSIZE, FMT, dots);         \
    va_end(dots);                               \
                                                \
    BUF[BUFSIZE - 1] = '\0';                    \
  }

static void signal_retirement(const char* source, const char* buf);
static r_obj* deprecate_warn_call = NULL;

void deprecate_warn(const char* id, const char* fmt, ...) {
  char buf[BUFSIZE];
  INTERP(buf, fmt, ...);
  r_obj* msg_ = KEEP(r_chr(buf));

  id = id ? id : buf;
  r_obj* id_ = KEEP(r_chr(id));

  r_eval_with_xy(deprecate_warn_call, msg_, id_, r_envs.base);
  FREE(2);
}

void deprecate_stop(const char* fmt, ...) {
  char buf[BUFSIZE];
  INTERP(buf, fmt, ...);

  signal_retirement("deprecate_stop(msg = x)", buf);

  r_abort("Internal error: Unexpected return after `.Defunct()`");
}

static void signal_retirement(const char* source, const char* buf) {
  r_obj* call = KEEP(r_parse(source));
  r_obj* msg = KEEP(r_chr(buf));

  r_eval_with_x(call, msg, rlang_ns_env);

  FREE(2);
}


#define R_SUBSET_NAMES_N 4
static const char* r_subset_names[R_SUBSET_NAMES_N] = { "$", "@", "::", ":::" };

bool r_is_prefixed_call(r_obj* x, const char* name) {
  if (r_typeof(x) != LANGSXP) {
    return false;
  }

  r_obj* head = r_node_car(x);
  if (!r_is_call_any(head, r_subset_names, R_SUBSET_NAMES_N)) {
    return false;
  }

  if (name) {
    r_obj* rhs = r_node_cadr(r_node_cdr(head));
    if (!r_is_symbol(rhs, name)) {
      return false;
    }
  }

  return true;
}

bool r_is_namespaced_call(r_obj* x, const char* ns, const char* name) {
  if (r_typeof(x) != LANGSXP) {
    return false;
  }

  r_obj* head = r_node_car(x);
  if (!r_is_call(head, "::")) {
    return false;
  }

  if (ns) {
    r_obj* lhs = r_node_cadr(head);
    if (!r_is_symbol(lhs, ns)) {
      return false;
    }
  }

  if (name) {
    r_obj* rhs = r_node_cadr(r_node_cdar(x));
    if (!r_is_symbol(rhs, name)) {
      return false;
    }
  }

  return true;
}

bool r_is_namespaced_call_any(r_obj* x, const char* ns,
                              const char** names, int n) {
  if (!r_is_namespaced_call(x, ns, NULL)) {
    return false;
  }

  r_obj* args = r_node_cdar(x);
  r_obj* sym = r_node_cadr(args);
  return r_is_symbol_any(sym, names, n);
}

r_obj* nms_are_duplicated(r_obj* nms, bool from_last) {
  if (r_typeof(nms) != R_TYPE_character) {
    r_abort("Internal error: Expected a character vector of names for checking duplication");
  }
  r_obj* dups = KEEP(Rf_duplicated(nms, from_last));

  r_ssize n = r_length(dups);
  int* p_dups = r_lgl_begin(dups);
  r_obj* const * p_nms = r_chr_cbegin(nms);

  for (r_ssize i = 0; i < n; ++i) {
    if (p_nms[i] == r_strs.empty || p_nms[i] == r_globals.na_str) {
      p_dups[i] = false;
    }
  }

  FREE(1);
  return dups;
}

bool vec_find_first_duplicate(r_obj* x, r_obj* except, r_ssize* index) {
  r_ssize idx;
  if (except) {
    idx = Rf_any_duplicated3(x, except, false);
  } else {
    idx = Rf_any_duplicated(x, false);
  }

  if (idx) {
    if (index) {
      *index = idx - 1;
    }
    return true;
  } else {
    return false;
  }
}

// Can use simple pointer hashing thanks to the string pool
r_obj* chr_detect_dups(r_obj* x) {
  if (r_typeof(x) != R_TYPE_character) {
    r_stop_internal("`x` must be a character vector.");
  }

  x = KEEP(r_obj_encode_utf8(x));

  // Sentinel for duplicates
  r_obj* dup_flag = r_strs.empty;

  r_ssize n = r_length(x);
  r_obj* const * v_data = r_chr_cbegin(x);

  struct r_dict* p_dict = r_new_dict(n);
  KEEP(p_dict->shelter);

  for (r_ssize i = 0; i < n; ++i) {
    r_obj* key = v_data[i];

    r_obj* val = r_dict_get0(p_dict, key);
    if (val == NULL) {
      r_dict_put(p_dict, key, r_null);
    } else if (val == r_null) {
      r_dict_poke(p_dict, key, dup_flag);
    }
  }

  r_obj* out = KEEP(r_alloc_logical(n));
  int* v_out = r_lgl_begin(out);

  for (r_ssize i = 0; i < n; ++i) {
    v_out[i] = r_dict_get(p_dict, v_data[i]) == dup_flag;
  }

  FREE(3);
  return out;
}

r_obj* ffi_has_local_precious_list(void) {
  return r_lgl(_r_use_local_precious_list);
}
r_obj* ffi_use_local_precious_list(r_obj* x) {
  bool old = _r_use_local_precious_list;
  _r_use_local_precious_list = r_as_bool(x);
  return r_lgl(old);
}

r_obj* ffi_getppid(void) {
  return r_getppid();
}


void rlang_init_utils(void) {
  deprecate_warn_call = r_parse("rlang:::deprecate_warn(x, id = y)");
  r_preserve(deprecate_warn_call);

  deprecate_soft_call = r_parse("rlang:::deprecate_soft(x, id = y, user_env = z)");
  r_preserve(deprecate_soft_call);
}
