#include "rlang.h"


r_obj* r_eval_with_x(r_obj* call, r_obj* x, r_obj* parent) {
  r_obj* env = KEEP(r_alloc_environment(1, parent));
  r_env_bind(env, r_syms.x, x);

  r_obj* out = r_eval(call, env);

  FREE(1);
  return out;
}
r_obj* r_eval_with_xy(r_obj* call, r_obj* x, r_obj* y, r_obj* parent) {
  r_obj* env = KEEP(r_alloc_environment(2, parent));
  r_env_bind(env, r_syms.x, x);
  r_env_bind(env, r_syms.y, y);

  r_obj* out = r_eval(call, env);

  FREE(1);
  return out;
}
r_obj* r_eval_with_xyz(r_obj* call, r_obj* x, r_obj* y, r_obj* z, r_obj* parent) {
  r_obj* env = KEEP(r_alloc_environment(3, parent));
  r_env_bind(env, r_syms.x, x);
  r_env_bind(env, r_syms.y, y);
  r_env_bind(env, r_syms.z, z);

  r_obj* out = r_eval(call, env);

  FREE(1);
  return out;
}
r_obj* r_eval_with_wxyz(r_obj* call, r_obj* w, r_obj* x, r_obj* y, r_obj* z, r_obj* parent) {
  r_obj* env = KEEP(r_alloc_environment(4, parent));
  r_env_bind(env, r_syms.w, w);
  r_env_bind(env, r_syms.x, x);
  r_env_bind(env, r_syms.y, y);
  r_env_bind(env, r_syms.z, z);

  r_obj* out = r_eval(call, env);

  FREE(1);
  return out;
}


// Evaluate call with a preallocated environment containing a single
// `x` binding and inheriting from base env.
//
// Since this has side effects, it should not be used when there is a
// chance of recursing into the C library. It should only be used to
// evaluate pure R calls or functions from other packages, such as the
// base package.

static r_obj* shared_x_env;
static r_obj* shared_xy_env;
static r_obj* shared_xyz_env;

r_obj* eval_with_x(r_obj* call, r_obj* x) {
  r_env_bind(shared_x_env, r_syms.x, x);

  r_obj* out = KEEP(r_eval(call, shared_x_env));

  // Release for gc
  r_env_bind(shared_x_env, r_syms.x, r_null);

  FREE(1);
  return out;
}

r_obj* eval_with_xy(r_obj* call, r_obj* x, r_obj* y) {
  r_env_bind(shared_xy_env, r_syms.x, x);
  r_env_bind(shared_xy_env, r_syms.y, y);

  r_obj* out = KEEP(r_eval(call, shared_xy_env));

  // Release for gc
  r_env_bind(shared_xy_env, r_syms.x, r_null);
  r_env_bind(shared_xy_env, r_syms.y, r_null);

  FREE(1);
  return out;
}

r_obj* eval_with_xyz(r_obj* call, r_obj* x, r_obj* y, r_obj* z) {
  r_env_bind(shared_xyz_env, r_syms.x, x);
  r_env_bind(shared_xyz_env, r_syms.y, y);
  r_env_bind(shared_xyz_env, r_syms.z, z);

  r_obj* out = KEEP(r_eval(call, shared_xyz_env));

  // Release for gc
  r_env_bind(shared_xyz_env, r_syms.x, r_null);
  r_env_bind(shared_xyz_env, r_syms.y, r_null);
  r_env_bind(shared_xyz_env, r_syms.z, r_null);

  FREE(1);
  return out;
}


r_obj* r_exec_mask_n(r_obj* fn_sym,
                     r_obj* fn,
                     const struct r_pair* args,
                     int n,
                     r_obj* parent) {
  r_obj* mask = KEEP(r_alloc_environment(n + 1, parent));
  r_obj* call = KEEP(r_exec_mask_n_call_poke(fn_sym, fn, args, n, mask));

  r_obj* out = r_eval(call, mask);

  FREE(2);
  return out;
}

r_obj* r_exec_n(r_obj* fn_sym,
                r_obj* fn,
                const struct r_pair* args,
                int n,
                r_obj* env) {
  r_obj* call = KEEP(r_exec_mask_n_call_poke(fn_sym, fn, args, n, env));
  r_obj* out = r_eval(call, env);

  FREE(1);
  return out;
}

// Create a call from arguments and poke elements with a non-NULL
// symbol in `env`. Symbolic arguments are protected from evaluation
// with `quote()`.
r_obj* r_exec_mask_n_call_poke(r_obj* fn_sym,
                               r_obj* fn,
                               const struct r_pair* args,
                               int n,
                               r_obj* env) {
  if (fn_sym != r_null) {
    r_env_bind(env, fn_sym, fn);
    fn = fn_sym;
  }

  r_obj* list = KEEP(r_new_pairlist(args, n, NULL));

  r_obj* node = list;
  while (node != r_null) {
    r_obj* car = r_node_car(node);
    r_obj* tag = r_node_tag(node);

    if (tag == r_null) {
      // If symbol is not supplied, protect symbolic arguments from
      // evaluation. If supplied this is not needed because of the
      // masking.
      r_node_poke_car(node, r_expr_protect(car));
    } else {
      // If symbol is supplied, assign the value in the environment and
      // use the symbol instead of the value in the list of arguments
      r_env_bind(env, tag, car);
      r_node_poke_car(node, tag);
    }

    node = r_node_cdr(node);
  }

  r_obj* call = r_new_call(fn, list);

  FREE(1);
  return call;
}


void r_init_library_eval(void) {
  r_lazy_missing_arg = (struct r_lazy) { .x = r_missing_arg, .env = r_null };
}

struct r_lazy r_lazy_null = { 0 };
struct r_lazy r_lazy_missing_arg = { 0 };
