Exemple #1
0
lval* lval_call(lenv* e, lval* f, lval* a){

    if(f->builtin) {
        return f->builtin(e,a);
    }

    int given = a->count;
    int total = f->formals->count;


    while(a->count){
        if(f->formals->count == 0){
            lval_del(a); return lval_err("too many args. expected %i, got %i",
                                         total, given);
        }

        lval* sym = lval_pop(f->formals, 0);

        if(strcmp(sym->sym, "&") == 0){
            if(f->formals->count != 1){
                lval_del(a);
                return lval_err("too many args after '&'.  only 1 allowed");
            }

            lval* nsym = lval_pop(f->formals, 0);
            lenv_put(f->env, nsym, builtin_list(e, a));
            lval_del(sym); lval_del(nsym);
            break;
        }

        lval* val = lval_pop(a, 0);
        lenv_put(f->env, sym, val);
        lval_del(sym);
        lval_del(val);
    }

    lval_del(a);

    if(f->formals->count >0 &&
       strcmp(f->formals->cell[0]->sym, "&") == 0){
        if(f->formals->count != 2){
            return lval_err("'&' should be followed by a single arg");
        }

        lval_del(lval_pop(f->formals, 0));

        lval* sym = lval_pop(f->formals, 0);
        lval* val = lval_qexpr();

        lenv_put(f->env, sym, val);
        lval_del(sym); lval_del(val);
    }

    if(f->formals->count == 0){
        f->env->par = e;
        return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
    }else{
        return lval_copy(f);
    }
}
Exemple #2
0
lval* lval_call(lenv* env, lval* function, lval* args) {
    lval_func* func = function->data.func;
    
    if (func->builtin != NULL) {
        return func->builtin(env, args);
    }
    
    //Check arg counts
    LASSERT(args, func->formals->cell_count <= args->cell_count, LERR_SYNTAX,
            "lambda: insufficient arguments. Expected %ld got %ld", func->formals->cell_count, args->cell_count);
    
    for(int i = 0; i < func->formals->cell_count; i++) {
        lenv_put(func->env, func->formals->cell_list[i], args->cell_list[i]);
    }
    
    if (func->va != NULL) {
        lval* vaArgs = lval_q_expr();
        
        for(int i = func->formals->cell_count; i < args->cell_count; i ++ ) {
            lval_add(vaArgs, lval_copy(args->cell_list[i]));
        }
        
        lenv_put(func->env, func->va, vaArgs);
        lval_delete(vaArgs);
    }
    
    lval_delete(args);
    
    func->env->parent = env;
    
    return eval(func->env, lval_add(lval_s_expr(), lval_copy(func->body)));
}
Exemple #3
0
struct lval* lval_eval_call(struct lenv* e, struct lval* f, struct lval* args) {
    if (f->fun_type == LVAL_FUN_BUILTIN) {
        return f->builtin(e, args);
    }

    int given = args->count;
    int total = f->args->count;

    while (args->count) {
        if (f->args->count == 0) {
            lval_del(args);
            return lval_err(
                       "Too many arguments. Got %i, expected %i.",
                       given, total
                   );
        }

        struct lval* sym = lval_pop(f->args, 0);

        if (strcmp(sym->sym, "&") == 0) {
            // varargs
            lval_del(sym);
            sym = lval_pop(f->args, 0);
            lenv_put(f->env, sym->sym, lval_builtin_list(e, args));
            lval_del(sym);
            break;
        }

        struct lval* val = lval_pop(args, 0);
        lenv_put(f->env, sym->sym, val);

        lval_del(sym);
        lval_del(val);
    }

    lval_del(args);

    if (f->args->count > 0) {
        if (strcmp(f->args->cell[0]->sym, "&") != 0) {
            return lval_copy(f);
        }
        // Got all args except varargs, so produce empty list
        struct lval* val = lval_qexp();
        lenv_put(f->env, f->args->cell[1]->sym, val);
        lval_del(val);
    }

    f->env->parent = e;

    struct lval* sexp = lval_sexp();
    lval_add(sexp, lval_copy(f->body));

    return lval_builtin_eval(f->env, sexp);
}
Exemple #4
0
lval* builtin_var(lenv* e, lval* a, char* func)
{
  LASSERT_TYPE(func, a, 0, LVAL_QEXPR);

  lval* syms = a->cell[0];

  for (int i = 0; i < syms->count; i++)
    LASSERT(a, syms->cell[i]->type == LVAL_SYM,
      "Function '%s' cannot define a non-symbol.  Got %s, Expected %s.",
      func, ltype_name(syms->cell[i]->type), ltype_name(LVAL_SYM));

  LASSERT(a, syms->count == a->count - 1,
    "Function '%s' passed too many arguments for symbols.  Got %i, Expected %i.",
    func, syms->count, a->count - 1);

  for (int i = 0; i < syms->count; i++)
  {
    if (strcmp(func, "def") == 0)
      lenv_def(e, syms->cell[i], a->cell[i+1]);
    
    if (strcmp(func, "=") == 0)
      lenv_put(e, syms->cell[i], a->cell[i+1]);
  }

  lval_del(a);
  return lval_sexpr();
}
Exemple #5
0
void lenv_add_builtin(lenv* e, char* name, lbuiltin func){
    lval_t* k = lval_sym(name);
    lval_t* v = lval_fun(func);
    lenv_put(e, k, v);
    lval_free(k);
    lval_free(v);
}
Exemple #6
0
lval *builtin_var(lenv *e, lval *a, char *func)
{
  LASSERT_TYPE("def", a, 0, LVAL_QEXPR);
  lval *syms = a->cell[0];
  for (int i = 0; i < syms->count; i++)
  {
    LASSERT(a, (syms->cell[i]->type == LVAL_SYM),
      "Function 'def' cannot define non-symbol"
      "\n  got %s expected %s",
      ltype_name(syms->cell[i]->type), ltype_name(LVAL_SYM));
  }
  LASSERT(a, (syms->count == a->count-1),
    "Function 'def' passed too many arguments for symbols"
    "\n  got %i expected %i",
    syms->count, a->count-1);
  for (int i = 0; i < syms->count; i++)
  {
    if (strcmp(func, "def") == 0)
    {
      lenv_def(e, syms->cell[i], a->cell[i + 1]);
    }
    if (strcmp(func, "=") == 0)
    {
      lenv_put(e, syms->cell[i], a->cell[i + 1]);
    }
  }
  lval_del(a);
  return lval_sexpr();
}
Exemple #7
0
void lenv_def(lenv *e, lval *k, lval *v)
{
  while (e->par)
  {
    e = e->par;
  }
  lenv_put(e, k, v);
}
Exemple #8
0
lval* lval_call(lenv* e, lval* f, lval* a) {

  if (f->builtin) { return f->builtin(e, a); }

  int given = a->count;
  int total = f->formals->count;

  while (a->count) {

    if (f->formals->count == 0) {
      lval_del(a); return lval_err(
        "Function passed too many arguments. "
        "Got %i, Expected %i.", given, total); 
    }

    lval* sym = lval_pop(f->formals, 0);

    lval* val = lval_pop(a, 0);

    lenv_put(f->env, sym, val);

    lval_del(sym); lval_del(val);
  }

  lval_del(a);

  if (f->formals->count == 0) {

    f->env->par = e;

    return builtin_eval(
      f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
  } else {
    return lval_copy(f);
  }
}
Exemple #9
0
lval *lval_call(lenv *e, lval *f, lval *a)
{
  if (f->builtin)
  {
    return f->builtin(e, a);
  }

  int given = a->count;
  int total = f->formals->count;

  while (a->count)
  {
    if (f->formals->count == 0)
    {
      lval_del(a);
      return lval_err("Function passed too many arguments\n"
        "  got %i expected %i", given, total);
    }
    lval *sym = lval_pop(f->formals, 0);

    if (strcmp(sym->sym, "&") == 0)
    {
      if (f->formals->count != 1)
      {
        lval_del(a);
        return lval_err("Function format invalid\n"
          "  symbol '&' not followed by single symbol");
      }
      lval *nsym = lval_pop(f->formals, 0);
      lenv_put(f->env, nsym, builtin_list(e, a));
      lval_del(sym);
      lval_del(nsym);
      break;
    }

    lval *val = lval_pop(a, 0);
    lenv_put(f->env, sym, val);
    lval_del(sym);
    lval_del(val);
  }
  lval_del(a);

  if (f->formals->count > 0 && strcmp(f->formals->cell[0]->sym, "&") == 0)
  {
    if (f->formals->count != 2)
    {
      return lval_err("Function format invalid\n"
        "  symbol '&' not followed by single symbol");
    }

    lval_del(lval_pop(f->formals, 0));
    lval *sym = lval_pop(f->formals, 0);
    lval *val = lval_qexpr();
    lval_del(sym);
    lval_del(val);
  }

  if (f->formals->count == 0)
  {
    f->env->par = e;
    return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
  }
  else
  {
    return lval_copy(f);
  }
}
Exemple #10
0
int lenv_def(lenv* e, lval* k, lval* v)
{
	while (e->par)
		e = e->par;
	return lenv_put(e, k, v);
}
Exemple #11
0
void lenv_add_builtin(struct lenv* e, char* name, lfunc fn) {
    struct lval* v = lval_builtin(name, fn);
    lenv_put(e, name, v);
    lval_del(v);
}
Exemple #12
0
void lenv_def(struct lenv* e, char* sym, struct lval* v) {
    while (e->parent) e = e->parent;
    lenv_put(e, sym, v);
}
Exemple #13
0
lval* lval_call(lenv* e, lval* f, lval* a) {
    if (f->builtin) {
        return f->builtin(e, a);
    }

    int given = a->count;
    int total = f->formals->count;

    while (a->count) {
        if (f->formals->count == 0) {
            lval_del(a);
            return lval_err("Function passed too many arguments. Expected %i, Got %i.", total, given);
        }

        lval* sym = lval_pop(f->formals, 0);

        // Variadic operator
        if (strcmp(sym->sym, "&") == 0){
            if (f->formals->count != 1) {
                lval_del(a);
                return lval_err("Function format invalid. "
                        "Symbol '&' not followed by a single symbol");
            }

            lval* nsym = lval_pop(f->formals, 0);
            lenv_put(f->env, nsym, builtin_list(e, a));
            lval_del(sym);
            lval_del(nsym);
            break;
        }

        lval* val = lval_pop(a, 0);
        lenv_put(f->env, sym, val);
        lval_del(val);
        lval_del(sym);
    }

    lval_del(a);

    // If '&' remains in formal list bind to empty list
    if (f->formals->count > 0 &&
            strcmp(f->formals->cell[0]->sym, "&") == 0) {
        if (f->formals->count != 2) {
            return lval_err("Function format invalid. "
                    "Symbol '&' not followed by a single symbol");
        }

        lval_del(lval_pop(f->formals, 0));

        lval* sym = lval_pop(f->formals, 0);
        lval* val = lval_qexpr();

        lenv_put(f->env, sym, val);
        lval_del(val);
        lval_del(sym);
    }

    if (f->formals->count == 0) {
        f->env->par = e;
        return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
    } else {
        return lval_copy(f);
    }
}
lval* lval_call(lenv* e, lval* f, lval* a) {

  /* If Builtin then simply apply that */
  if (f->builtin) { return f->builtin(e, a); }

  /* Record Argument Counts */
  int given = a->count;
  int total = f->formals->count;

  /* While arguments still remain to be processed */
  while (a->count) {

    /* If we've ran out of formal arguments to bind */
    if (f->formals->count == 0) {
      lval_del(a);
      return lval_err("Function passed too many arguments. Got %i, Expected %i.", given, total);
    }

    /* Pop the first symbol from the formals */
    lval* sym = lval_pop(f->formals, 0);

    /* Special Case to deal with '&' */
    if (strcmp(sym->sym, "&") == 0) {

      /* Ensure '&' is followed by another symbol */
      if (f->formals->count != 1) {
        lval_del(a);
        return lval_err("Function format invalid. Symbol '&' not followed by single symbol.");
      }

      /* Next formal should be bound to remaining arguments */
      lval* nsym = lval_pop(f->formals, 0);
      lenv_put(f->env, nsym, builtin_list(e, a));
      lval_del(sym); lval_del(nsym);
      break;
    }

    /* Pop the next argument from the list */
    lval* val = lval_pop(a, 0);

    /* Bind a copy into the function's environment */
    lenv_put(f->env, sym, val);

    /* Delete symbol and value */
    lval_del(sym); lval_del(val);
  }

  /* Argument list is now bound so can be cleaned up */
  lval_del(a);

  /* If '&' remains in formal list it should be bound to empty list */
  if (f->formals->count > 0 &&
    strcmp(f->formals->cell[0]->sym, "&") == 0) {

    /* Check to ensure that & is not passed invalidly. */
    if (f->formals->count != 2) {
      return lval_err("Function format invalid. Symbol '&' not followed by single symbol.");
    }

    /* Pop and delete '&' symbol */
    lval_del(lval_pop(f->formals, 0));

    /* Pop next symbol and create empty list */
    lval* sym = lval_pop(f->formals, 0);
    lval* val = lval_qexpr();

    /* Bind to environment and delete */
    lenv_put(f->env, sym, val);
    lval_del(sym); lval_del(val);
  }

  /* If all formals have been bound evaluate */
  if (f->formals->count == 0) {

    /* Set Function Environment parent to current evaluation Environment */
    f->env->par = e;

    /* Evaluate and return */
    return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
  } else {
    /* Otherwise return partially evaluated function */
    return lval_copy(f);
  }

}
void lenv_add_builtin(lenv* e, char* name, lbuiltin func) {
  lval* k = lval_sym(name);
  lval* v = lval_builtin(func);
  lenv_put(e, k, v);
  lval_del(k); lval_del(v);
}
void lenv_def(lenv* e, lval* k, lval* v) {
  /* Iterate till e has no parent */
  while (e->par) { e = e->par; }
  /* Put value in e */
  lenv_put(e, k, v);
}