#include <rlang.h>
#include "internal.h"
#include "decl/call-decl.h"
#include "utils.h"
#include "vec.h"


r_obj* ffi_is_call(r_obj* x, r_obj* name, r_obj* ffi_n, r_obj* ns) {
  if (r_typeof(x) != R_TYPE_call) {
    return r_false;
  }

  if (ns != r_null) {
    if (!is_character(ns, -1, OPTION_BOOL_false, OPTION_BOOL_null)) {
      r_abort("`ns` must be a character vector of namespaces.");
    }

    bool found = false;
    r_obj* const * v_ns = r_chr_cbegin(ns);
    r_ssize ns_len = r_length(ns);

    for (r_ssize i = 0; i < ns_len; ++i) {
      r_obj* elt = v_ns[i];

      if ((elt == r_strs.empty && !call_is_namespaced(x, r_null))
            || call_is_namespaced(x, elt)) {
        found = true;
        break;
      }
    }

    if (!found) {
      return r_false;
    }
  }

  x = KEEP(call_unnamespace(x));

  if (name != r_null) {
    r_obj* fn = r_node_car(x);
    if (r_typeof(fn) != R_TYPE_symbol) {
      FREE(1);
      return r_false;
    }

    switch (r_typeof(name)) {
    case R_TYPE_symbol:
      if (fn == name) {
        goto found_name;
      }
      FREE(1);
      return r_false;

    // List of symbols
    case R_TYPE_list: {
      r_obj* const * v_name = r_list_cbegin(name);
      r_ssize name_len = r_length(name);

      for (r_ssize i = 0; i < name_len; ++i) {
        if (fn == v_name[i]) {
          goto found_name;
        }
      }
      FREE(1);
      return r_false;
    }

    default:
      break;
    }

    if (!is_character(name, -1, OPTION_BOOL_false, OPTION_BOOL_false)) {
      r_abort("`name` must be a character vector of names.");
    }

    fn = r_sym_string(fn);
    r_obj* const * v_name = r_chr_cbegin(name);
    r_ssize name_len = r_length(name);

    for (r_ssize i = 0; i < name_len; ++i) {
      if (fn == v_name[i]) {
        goto found_name;
      }
    }
    FREE(1);
    return r_false;
  }
 found_name:

  if (ffi_n != r_null) {
    r_ssize n = validate_n(ffi_n);
    if (!_r_has_correct_length(r_node_cdr(x), n)) {
      FREE(1);
      return r_false;
    }
  }

  FREE(1);
  return r_true;
}

static
bool call_is_namespaced(r_obj* x, r_obj* ns) {
  if (r_typeof(x) != R_TYPE_call) {
    return(false);
  }

  r_obj* car = r_node_car(x);
  if (r_typeof(car) != R_TYPE_call) {
    return(false);
  }

  if (ns != r_null) {
    r_obj* arg = r_node_cadr(car);
    if (r_typeof(arg) != R_TYPE_symbol || r_sym_string(arg) != ns) {
      return false;
    }
  }

  return r_node_car(car) == r_syms.colon2;
}

static inline
r_obj* call_unnamespace(r_obj* x) {
  if (call_is_namespaced(x, r_null)) {
    return r_new_call(r_node_cadr(r_node_cdar(x)), r_node_cdr(x));
  } else {
    return x;
  }
}


r_obj* rlang_call2(r_obj* fn, r_obj* args, r_obj* ns) {
  if (r_typeof(fn) == R_TYPE_character) {
    if (r_length(fn) != 1) {
      r_abort("`.fn` must be a string, a symbol, a call, or a function");
    }
    fn = r_sym(r_chr_get_c_string(fn, 0));
  } else if (!is_callable(fn)) {
    r_abort("Can't create call to non-callable object");
  }

  int n_kept = 0;

  if (ns != r_null) {
    if (!r_is_string(ns)) {
      r_abort("`ns` must be a string");
    }
    if (r_typeof(fn) != R_TYPE_symbol) {
      r_abort("`fn` must be a string or symbol when a namespace is supplied");
    }
    ns = r_sym(r_chr_get_c_string(ns, 0));
    fn = KEEP_N(r_call3(r_syms.colon2, ns, fn), &n_kept);
  }

  r_obj* out = r_new_call(fn, args);

  FREE(n_kept);
  return out;
}

r_obj* ffi_call2(r_obj* call, r_obj* op, r_obj* args, r_obj* env) {
  args = r_node_cdr(args);

  r_obj* fn = KEEP(r_eval(r_sym(".fn"), env));
  r_obj* ns = KEEP(r_eval(r_sym(".ns"), env));
  r_obj* dots = KEEP(rlang_dots(env));

  r_obj* out = rlang_call2(fn, dots, ns);

  FREE(3);
  return out;
}

static
bool is_callable(r_obj* x) {
  switch (r_typeof(x)) {
  case R_TYPE_symbol:
  case R_TYPE_call:
  case R_TYPE_closure:
  case R_TYPE_builtin:
  case R_TYPE_special:
    return true;
  default:
    return false;
  }
}


r_obj* ffi_call_zap_inline(r_obj* x) {
  if (r_typeof(x) == R_TYPE_call) {
    r_obj* out = KEEP(r_call_clone(x));
    call_zap_inline(out);
    FREE(1);
    return out;
  } else {
    return call_zap_one(x);
  }
}

static
void call_zap_inline(r_obj* x) {
  if (r_node_car(x) == r_syms.function) {
    call_zap_fn(x);
  } else {
    node_zap_inline(x);
  }
}

static
void node_zap_inline(r_obj* x) {
  while (x != r_null) {
    r_node_poke_car(x, call_zap_one(r_node_car(x)));
    x = r_node_cdr(x);
  }
}

static
void call_zap_fn(r_obj* x) {
  // Formals
  x = r_node_cdr(x);
  node_zap_inline(r_node_car(x));

  // Body
  x = r_node_cdr(x);
  r_node_poke_car(x, call_zap_one(r_node_car(x)));

  // Zap srcref
  x = r_node_cdr(x);
  r_node_poke_car(x, r_null);
}

static
r_obj* call_zap_one(r_obj* x) {
  switch (r_typeof(x)) {
  case R_TYPE_call:
    call_zap_inline(x);
    return x;

  case R_TYPE_null:
  case R_TYPE_symbol:
    return x;

  // Syntactic literals
  case R_TYPE_logical:
  case R_TYPE_integer:
  case R_TYPE_double:
  case R_TYPE_character:
  case R_TYPE_complex: // Not entirely correct for complex
    if (!r_attrib_has_any(x) && r_length(x) == 1) {
      return x;
    } else {
      return type_sum(x);
    }

  default:
    return type_sum(x);
  }
}

static
r_obj* type_sum(r_obj* x) {
  return r_eval_with_x(type_sum_call, x, rlang_ns_env);
}


void rlang_init_call(r_obj* ns) {
  type_sum_call = r_parse("call_type_sum(x)");
  r_preserve_global(type_sum_call);
}

static
r_obj* type_sum_call = NULL;
