pt-lisp/implementations/c/src/evaluator.c

#include <stdio.h>
#include "lisp.h"

static Pointer run_fn(Func fn, Pointer params) {
  Pointer body = CAR(fn.code);
  Pointer args = CDR(fn.code);
  Pointer env = fn.env;
  Pointer value = NIL;
  Pointer tbl = table(2);

  env = cons(tbl, env);
  while(args != NIL && params != NIL) {
      table_set(tbl, CAR(args), CAR(params));
      args = CDR(args);
      params = CDR(params);
  }

  REDUCE(body, eval_fn(body, env), value);
  return value;
}

Pointer eval(Pointer data, Pointer env) {
  if (data == NIL) return NIL;

  switch(TYPE(data)) {
  case CONS: {
    Pointer op = eval(CAR(data), env);
    Type type = TYPE(op);
    data = CDR(data);
    if (type == SPECIAL_FORM) {
      return SPECIAL_FORM(op)(data, env);
    }
    
    Pointer params = NIL;
    if (data != NIL) {
      Pointer* cdr = &params;
      while (data != NIL) {
	*cdr = cons(eval(CAR(data), env), NIL);
	cdr = &CONS(*cdr).cdr;
	data = CDR(data);
      }
      *cdr = NIL;
    }
    
    if (type == NATIVE_FUNC) {
      return NATIVE_FUNC(op)(params, env);
    }
    
    if (type == FUNC) {
      return run_fn(FUNC(op), params);
    }
    printf("%s: %d\n", __FILE__, __LINE__);
    return UNDEFINED;
  } 
  case SYMBOL: return environment_get(env, data);
  default: return data;
  }
}

Pointer eval_fn(Pointer args, Pointer env) {
  return eval(CAR(args), env);
}