void evaluate_test(double* w)
{
int i;
double *true_labels = Malloc(double,probtest.l);
double *dec_values = Malloc(double,probtest.l);
if(&probtest != NULL)
{
for(i = 0; i < probtest.l; ++i)
{
feature_node *x = probtest.x[i];
true_labels[i] = probtest.y[i];
double predict_label = 0;
for(; x->index != -1; ++x)
predict_label += w[x->index-1]*x->value;
dec_values[i] = predict_label;
}
}
double result[3];
eval_list(true_labels, dec_values, probtest.query, probtest.l, result);
info("Pairwise Accuracy = %g%%\n",result[0]*100);
info("MeanNDCG (LETOR) = %g\n",result[1]);
info("NDCG (YAHOO) = %g\n",result[2]);
free(true_labels);
free(dec_values);
}
Value eval(Value expression, Environment *environment) {
switch (expression.type) {
/* Self evaluating: */
case ERROR:
case NIL:
case INTEGER:
case FLOAT:
case STRING:
case VECTOR:
case HASH:
case LAMBDA: // Evaluation is not the same as calling
default:
return expression;
case SYMBOL: {
Value result;
Bool found = environment_lookup_variable(expression, &result, environment);
if (found) {
return result;
} else {
/* TODO: log error */
/* TODO: "Did you mean?" */
debug_value(expression);
log_error("Variable XXX not found");
return VALUE_ERROR;
}
}
case CONS:
return eval_list(expression, environment);
}
}
// (cons expr expr)
static Obj *prim_cons(void *root, Obj **env, Obj **list) {
if (length(*list) != 2)
error("Malformed cons");
Obj *cell = eval_list(root, env, list);
cell->cdr = cell->cdr->car;
return cell;
}
uptr_t eval(uptr_t *env, uptr_t form) {
if (IS_INT(form) || IS_NIL(form))
return form;
if (IS_SYM(form))
return get(*env, form);
if (IS_CONS(form)) {
uptr_t *form_p = refer(form),
*fn_p = refer(eval(env, CAR(*form_p))),
rval;
if (IS_SYM(*fn_p)) {
rval = exec_special(env, *form_p);
} else if (IS_CONS(*fn_p) && SVAL(CAR(*fn_p)) == S_FN) {
rval = _fn(env, *fn_p, eval_list(env, CDR(*form_p)));
} else {
printf_P(PSTR("ERROR: "));
print_form(CAR(*form_p));
printf_P(PSTR(" cannot be in function position.\n"));
rval = NIL;
}
release(2); // form_p, fn_p
return rval;
}
return NIL;
}
Obj *prim_negate(Env *env, Obj *root, Obj **list) {
VAR(args);
*args = eval_list(env, root, list);
if ((*args)->car->type != TINT || (*args)->cdr != Nil)
error("negate takes only one number");
return make_int(env, root, -(*args)->car->value);
}
loliObj* loliCons::eval(loliObj* env){
this->type = typeCONS;
// std::cout<<this->type->toString()<<std::endl;
if(this->head() == SYM("if")){
loliObj* cond = lcons(this->tail())->head();
if(this->tail()->nilp()){
loli_err("Need at least one expression for if");
return nil;
}
loliObj* wt = lcons(lcons(this->tail())->tail())->head();
loliObj* wf = lcons(lcons(lcons(this->tail())->tail())->tail())->head();
if(cond->eval(env)==boolt){
return wt->eval(top_env);
}else if(cond->eval(env)==boolf){
if(wf){
return wf->eval(top_env);
}else{
return nil;
}
}else{
loli_err("Condition error");
return nil;
}
}
return eval_list(this, env);
}
SExp* Eval::eval_list(SExp* l, SExp* a,Tree* d)
{
char sStr[1000];
memset(sStr,0,1000);
if(l->isNIL()!=1)
{
}
else
return new SExp(0);
if(l->isAtom==1)
{
l->convertString(sStr);
ErrorManager E;
E.buildRunTimeErrors(ErrorManager::NOT_LIST,sStr);
}
SExp* q1=eval(l->car,a,d);
if(q1!=NULL){
}else
return NULL;
SExp* q2=eval_list(l->cdr,a,d);
if(q2!=NULL){
}else
return NULL;
return cons(q1,q2);
}
// (setcar <cell> expr)
static Obj *prim_setcar(void *root, Obj **env, Obj **list) {
DEFINE1(args);
*args = eval_list(root, env, list);
if (length(*args) != 2 || (*args)->car->type != TCELL)
error("Malformed setcar");
(*args)->car->car = (*args)->cdr->car;
return (*args)->car;
}
// (begin expr ...)
static Obj *prim_begin(void *root, Obj **env, Obj **list) {
if (length(*list) < 1)
error("Malformed begin");
DEFINE1(exprs);
*exprs = (*list); //->car;
eval_list(root, env, exprs);
return Nil;
}
// (+ <integer> ...)
static Obj *prim_plus(void *root, Obj **env, Obj **list) {
int sum = 0;
for (Obj *args = eval_list(root, env, list); args != Nil; args = args->cdr) {
if (args->car->type != TINT)
error("+ takes only numbers");
sum += args->car->value;
}
return make_int(root, sum);
}
uptr_t eval_list(uptr_t *env, uptr_t list) {
if (IS_NIL(list))
return NIL;
uptr_t *list_p = refer(list), rval;
rval = build_cons(eval(env, CAR(*list_p)), eval_list(env, CDR(*list_p)));
release(1); // list_p
return rval;
}
Obj *prim_num_eq(Env *env, Obj *root, Obj **list) {
if (list_length(*list) != 2)
error("malformed =");
VAR(values);
*values = eval_list(env, root, list);
if ((*values)->car->type != TINT || (*values)->cdr->car->type != TINT)
error("= only takes number");
return (*values)->car->value == (*values)->cdr->car->value ? True : Nil;
}
// (= <integer> <integer>)
static Obj *prim_num_eq(void *root, Obj **env, Obj **list) {
if (length(*list) != 2)
error("Malformed =");
Obj *values = eval_list(root, env, list);
Obj *x = values->car;
Obj *y = values->cdr->car;
if (x->type != TINT || y->type != TINT)
error("= only takes numbers");
return x->value == y->value ? True : Nil;
}
// (< <integer> <integer>)
static Obj *prim_lt(void *root, Obj **env, Obj **list) {
Obj *args = eval_list(root, env, list);
if (length(args) != 2)
error("malformed <");
Obj *x = args->val.cell.car;
Obj *y = args->val.cell.cdr->val.cell.car;
if (x->type != TINT || y->type != TINT)
error("< takes only numbers");
return x->val.value < y->val.value ? True : Nil;
}
static Obj *prim_gte(void *root, Obj **env, Obj **list) {
Obj *args = eval_list(root, env, list);
if (length(args) != 2)
error("malformed >=");
Obj *x = args->car;
Obj *y = args->cdr->car;
if (x->type != TINT || y->type != TINT)
error(">= takes only numbers");
return x->value >= y->value ? True : Nil;
}
// (while cond expr ...)
static Obj *prim_while(void *root, Obj **env, Obj **list) {
if (length(*list) < 2)
error("Malformed while");
DEFINE2(cond, exprs);
*cond = (*list)->car;
while (eval(root, env, cond) != Nil) {
*exprs = (*list)->cdr;
eval_list(root, env, exprs);
}
return Nil;
}
// (- <integer> ...)
static Obj *prim_minus(void *root, Obj **env, Obj **list) {
Obj *args = eval_list(root, env, list);
for (Obj *p = args; p != Nil; p = p->cdr)
if (p->car->type != TINT)
error("- takes only numbers");
if (args->cdr == Nil)
return make_int(root, -args->car->value);
int r = args->car->value;
for (Obj *p = args->cdr; p != Nil; p = p->cdr)
r -= p->car->value;
return make_int(root, r);
}
// Apply fn with args.
static Obj *apply(void *root, Obj **env, Obj **fn, Obj **args) {
if (!is_list(*args))
error("argument must be a list");
if ((*fn)->type == TPRIMITIVE)
return (*fn)->fn(root, env, args);
if ((*fn)->type == TFUNCTION) {
DEFINE1(eargs);
*eargs = eval_list(root, env, args);
return apply_func(root, env, fn, eargs);
}
error("not supported");
}
Obj *prim_plus(Env *env, Obj *root, Obj **list) {
VAR(args);
*args = eval_list(env, root, list);
int sum = 0;
for (;;) {
if ((*args)->car->type != TINT)
error("+ takes only numbers");
sum += (*args)->car->value;
if ((*args)->cdr == Nil)
break;
if ((*args)->cdr->type != TCELL)
error("+ does not take incomplete list");
*args = (*args)->cdr;
}
return make_int(env, root, sum);
}
Obj *apply(Env *env, Obj *root, Obj **fn, Obj **args) {
if ((*fn)->type == TPRIMITIVE) {
if ((*args) != Nil && (*args)->type != TCELL)
error("argument must be a list");
return (*fn)->fn(env, root, args);
}
if ((*fn)->type == TFUNCTION) {
VAR(body);
VAR(params);
VAR(eargs);
*body = (*fn)->body;
*params = (*fn)->params;
Env newenv;
*eargs = eval_list(env, root, args);
add_env(env, root, &newenv, params, eargs);
return progn(&newenv, root, body);
}
error("not supported");
return NULL;
}
//LAB #2
Node *
Regular::eval_list(Node * p, Environment * env) {
if (p == NULL || p->isNull()){
Node * list = new Cons(new Nil(), new Nil());
return list;
}
else{
Node * arg1, * rest;
arg1 = p->getCar();
rest = p->getCdr();
if(arg1->isSymbol()){
arg1 = env->lookup(arg1);
}
if(arg1 == NULL || arg1->isNull()){
return new Nil();
}
Node * list = new Cons(arg1->eval(env), eval_list(rest, env));
return list;
}
}
//LAB #2
Node *
Regular::eval(Node * p, Environment * env) {
Node * front, * args;
front = p->getCar();
args = eval_list(p->getCdr(), env);
while(front->isSymbol()){
front = env->lookup(front);
}
if(front == NULL || front->isNull()){
cerr << "Undefined function\n";
return new Nil();
}
if(front->isProcedure()){ //built-in
return front->apply(args);
}
else{
return front->eval(env)->apply(args);
}
}
sexpr_t* eval(sexpr_t* sexpr, sexpr_t** env, sexpr_list_t* roots, error_t** error)
{
if(sexpr == NULL) {
return interp.nil_sym;
}
/* printf("[eval]\n"); */
/* print_sexpr(sexpr); */
/* printf("\n"); */
roots = cons_to_roots_list(roots, sexpr);
gc_collect(roots);
if(ATOM(sexpr)) {
if(SYM(sexpr)) {
if(interp.t_sym == sexpr) {
return interp.t_sym;
}
if(interp.nil_sym == sexpr) {
return interp.nil_sym;
}
sexpr_t* val = assoc(sexpr, *env);
if(val == NULL) {
*error = mk_error("Undefined symbol", SYM_VAL(sexpr));
}
return val;
}
if(INT(sexpr)) {
return sexpr;
}
} else if(ATOM(CAR(sexpr))) {
if(SYM(CAR(sexpr))) {
// quote
if(interp.quote_sym == CAR(sexpr)) {
if(CDR(sexpr) == NULL) {
*error = mk_error("Missing quote argument", "");
return NULL;
}
if(CDR(CDR(sexpr)) != NULL) {
*error = mk_error("Too many arguments for quote", "");
return NULL;
}
return CAR(CDR(sexpr));
}
// atom
if(interp.atom_sym == CAR(sexpr)) {
if(ATOM(eval(CAR(CDR(sexpr)), env, roots, error))) {
return interp.t_sym;
}
return interp.nil_sym;
}
// eq
if(interp.eq_sym == CAR(sexpr)) {
// TODO check nb args
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(INT(e1) && INT(e2)) {
if(INT_VAL(e1) == INT_VAL(e2)) {
return interp.t_sym;
}
return interp.nil_sym;
}
if(e1 == e2) {
return interp.t_sym;
}
return interp.nil_sym;
}
// if
if(interp.if_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(e1 == interp.nil_sym) {
return eval(CAR(CDR(CDR(CDR(sexpr)))), env, roots, error);
} else {
return eval(CAR(CDR(CDR(sexpr))), env, roots, error);
}
}
// car
if(interp.car_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(e1 == interp.nil_sym) {
return interp.nil_sym;
}
return CAR(e1);
}
// cdr
if(interp.cdr_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(e1 == interp.nil_sym) {
return interp.nil_sym;
}
sexpr_t *res = CDR(e1);
if(res == NULL) {
return interp.nil_sym;
}
return res;
}
// +
if(interp.plus_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(INT(e1) && INT(e2)) {
return mk_int(INT_VAL(e1) + INT_VAL(e2));
}
*error = mk_error("Arguments for '+' are not integers", "");
return NULL;
}
// -
if(interp.minus_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(INT(e1) && INT(e2)) {
return mk_int(INT_VAL(e1) - INT_VAL(e2));
}
*error = mk_error("Arguments for '-' are not integers", "");
return NULL;
}
if(interp.mul_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, sexpr);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
if(INT(e1) && INT(e2)) {
return mk_int(INT_VAL(e1) * INT_VAL(e2));
}
*error = mk_error("Arguments for '*' are not integers", "");
return NULL;
}
// cons
if(interp.cons_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
sexpr_t* e2 = eval(CAR(CDR(CDR(sexpr))), env, roots, error);
if(*error != NULL) {
return NULL;
}
return mk_cons(e1 == interp.nil_sym ? NULL : e1, e2 == interp.nil_sym ? NULL : e2);
}
// def
if(interp.def_sym == CAR(sexpr)) {
sexpr_t* arg = CAR(CDR(CDR(sexpr)));
roots = cons_to_roots_list(roots, arg);
sexpr_t* val = eval(arg, env, roots, error);
if(*error != NULL) {
return NULL;
}
*env = mk_cons(mk_cons(intern(SYM_VAL(CAR(CDR(sexpr)))), val), *env);
return val;
}
// print
if(interp.print_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
print_sexpr(e1);
printf("\n");
return e1;
}
// fn
if(interp.fn_sym == CAR(sexpr)) {
return mk_fn(sexpr, *env);
}
// macro
if(interp.macro_sym == CAR(sexpr)) {
return mk_macro(sexpr);
}
//eval
if(interp.eval_sym == CAR(sexpr)) {
sexpr_t* e1 = eval(CAR(CDR(sexpr)), env, roots, error);
if(*error != NULL) {
return NULL;
}
roots = cons_to_roots_list(roots, e1);
return eval(e1, env, roots, error);
}
// else resolves first variable
sexpr_t* fn = eval(CAR(sexpr), env, roots, error);
if(*error != NULL) {
return NULL;
}
// eval fn
if(FN(fn)) {
sexpr_t* fn_code = CAR(CDR(CDR(CAR(fn))));
sexpr_t* captured_env = CDR(fn);
sexpr_t* arguments = eval_list(CDR(sexpr), env, roots, error);
if(*error != NULL) {
return NULL;
}
sexpr_t* pairs = pair(CAR(CDR(CAR(fn))), arguments);
sexpr_t* eval_env = append(pairs, captured_env);
// append the function itself to the env, roots, for recursive calls
eval_env = mk_cons(mk_cons(CAR(sexpr), fn), eval_env);
/* printf("fn code=\n"); */
/* print_sexpr(fn_code); */
/* printf("\n"); */
roots = cons_to_roots_list(roots, eval_env);
return eval(fn_code, &eval_env, roots, error);
}
// eval macro
if(MACRO(fn)) {
sexpr_t* macro_code = CAR(CDR(CDR(CAR(fn))));
sexpr_t* pairs = pair(CAR(CDR(CAR(fn))), CDR(sexpr));
sexpr_t* eval_env = append(pairs, *env);
roots = cons_to_roots_list(roots, eval_env);
sexpr_t* transformed_code = eval(macro_code, &eval_env, roots, error);
if(*error != NULL) {
return NULL;
}
return eval(transformed_code, env, roots, error);
}
// else primitives
sexpr_t* arguments = eval_list(CDR(sexpr), env, roots, error);
if(*error != NULL) {
return NULL;
}
sexpr_t* to_eval = mk_cons(fn, arguments);
return eval(to_eval, env, roots, error);
}
} else if(CAR(CAR(sexpr)) == interp.fn_sym) {
// executes an anonymous function
sexpr_t* fn = CAR(sexpr);
sexpr_t* fn_code = CAR(CDR(CDR(fn)));
sexpr_t* arguments = eval_list(CDR(sexpr), env, roots, error);
if(*error != NULL) {
return NULL;
}
sexpr_t* l = pair(CAR(CDR(fn)), arguments);
l = append(l, *env);
roots = cons_to_roots_list(roots, l);
return eval(fn_code, &l, roots, error);
}
print_sexpr(sexpr);
printf("\n");
*error = mk_error("Invalid expression", "");
return NULL;
}
// (eq expr expr)
static Obj *prim_eq(void *root, Obj **env, Obj **list) {
if (length(*list) != 2)
error("Malformed eq");
Obj *values = eval_list(root, env, list);
return values->car == values->cdr->car ? True : Nil;
}
const Array::Temp Interpreter::eval_list(const char* string) const {
return eval_list(value_of(string));
}
Obj *prim_list(Env *env, Obj *root, Obj **list) {
return eval_list(env, root, list);
}
Obj *prim_car(Env *env, Obj *root, Obj **list) {
Obj *args = eval_list(env, root, list);
if (args->car->type != TCELL)
error("car takes only a cell");
return args->car->car;
}
Obj *prim_cdr(Env *env, Obj *root, Obj **list)
{
VAR(args);
*args = eval_list(env, root, list);
return (*args)->car->cdr;
}
// (cdr <cell>)
static Obj *prim_cdr(void *root, Obj **env, Obj **list) {
Obj *args = eval_list(root, env, list);
if (args->car->type != TCELL || args->cdr != Nil)
error("Malformed cdr");
return args->car->cdr;
}
Obj *prim_cons(Env *env, Obj *root, Obj **list)
{
VAR(args);
*args = eval_list(env, root, list);
return make_cell(env, root, &(*args)->car, &(*args)->cdr->car);
}
