lisp_eval_apply.c

 
Atom* lithp2_apply(Cons* env, Atom* list)
{
	DEBUG1("lithp2_apply: %s", list);
 
	// sanity check
	if(!list || !ISCONS(list)) {
		ERROR1("cannot apply a non cons: %s", list);
		return NIL;
	}
 
	Atom* head = CARATOM(list);
 
	// since we want to support evaluatable expressions at the head
	// eg. ((lambda x (+ 1 x)) 1) --> 2
	head = lithp2_eval(env, head);
 
	// make sure we got something executable
	if(!EXECUTABLE_ATOM(head)) {
		ERROR1("cannot apply. car is not executable: %s", head);
		return NIL;
	}
 
	Atom* new_list = NEW_CONS_ATOM2(head, CDRATOM(list));
 
	// if the function isn't special
	// eval each argument, build a new list for apply
	if(!isSpecialFunction(head)) {
		Atom* last_filled_cons = new_list;
		Atom* arg = CDRATOM(new_list);
 
		while(arg) {
			// if this is a dotted list we want to still evaluate
			// the thing after the dot
			Atom* safe_arg = arg;
			if(ISCONS(safe_arg)) {
				safe_arg = CARATOM(safe_arg);
			}
 
			Atom* new_arg = lithp2_eval(env, safe_arg);
 
			// add the newly eval'd arg to the new list for apply
			Atom* new_cons = NEW_CONS_ATOM2(new_arg, 0);
			CDRATOM(last_filled_cons) = new_cons;
			last_filled_cons = new_cons;
 
			// move to the next argument
			arg = CDRATOM(arg);
		}
	}
 
	DEBUG1("after prep for apply: %s", new_list);
 
	// apply!
	Atom* result = NIL;
	switch(ATOMTYPE(head)) {
		case SPECIAL_PRIMITIVE_ATOM:
		case PRIMITIVE_ATOM:
			// note: primitives don't expect themselves to
			// be in the list so we just past cdr
			result = ASPRIM(head)(env, CDRATOM(new_list));
			break;
		case SPECIAL_LAMBDA_ATOM:
		case LAMBDA_ATOM:
			result = lithp2_apply_lambda(env, new_list);
			break;
		case MACRO_ATOM:
		{
			Atom* new_code = lithp_expand_macro(env, new_list);
			// new code must be eval'able
			result = lithp2_eval(env, new_code);
			break;
		}
		default:
			ERROR1("apply: can't apply unknown type: %s", head);
			break;
	}
 
	DEBUG1("apply----> %s", result);
	return result;
}
 
Atom* lithp2_eval(Cons* env, Atom* atom)
{
	DEBUG1("lithp2_eval: %s", atom);
 
	Atom* result = NIL;
 
	if(atom) {
		switch(ATOMTYPE(atom)) {
			// numbers self evaluate
			case NUMBER_ATOM:
				result = atom;
				break;
 
			// cons must be applied
			case CONS_ATOM:
				result = lithp2_apply(env, atom);
				break;
 
			// symbols get looked up
			case SYMBOL_ATOM:
				result = lookupVariable(env, ASSYMBOL(atom));
				break;
 
			// these all self evaluate as well
			case SPECIAL_LAMBDA_ATOM:
			case LAMBDA_ATOM:
			case SPECIAL_PRIMITIVE_ATOM:
			case PRIMITIVE_ATOM:
			case MACRO_ATOM:
				result = atom;
				break;
			default:
				ERROR1("unrecognized type for eval: %s", atom);
				return NIL;
		}
	}
 
	DEBUG1("eval----> %s", result);
	return result;
}