#include #include #include #include "util.h" #include "internals.h" #include "symtable.h" object apply(object function, object parameters); object eval(object input) { object result; if (TYPE(input) == symbolObject) { result = referVariable(SYM(input)); } else if (TYPE(input) == consObject) { if (!properList(input)) { TYPE(result) = errorObject; ERR(result) = improperListError; } else { int specialForm = 0; if (TYPE(CAR(input)) == symbolObject && isSpecialForm(SYM(CAR(input)))) { specialForm = 1; CAR(input) = eval(CAR(input)); } object *currentCell = &input; int noErrors = 1; if (!specialForm) { while (TYPE(*currentCell) != nilObject) { CAR(*currentCell) = eval(CAR(*currentCell)); if (TYPE(CAR(*currentCell)) == errorObject) { noErrors = 0; TYPE(result) = errorObject; ERR(result) = ERR(CAR(*currentCell)); break; } currentCell = &CDR(*currentCell); } } if (noErrors) { result = apply(CAR(input), CDR(input)); } } } else { result = copyObject(input); } deleteObject(input); return result; } object apply(object procedure, object parameters) { object result; if (TYPE(procedure) != procedureObject) { TYPE(result) = errorObject; ERR(result) = notApplicableError; return result; } if (PROC_TYPE(procedure) == builtinProc) { object(*f)() = PROC_BUILTIN(procedure); result = f(parameters); return result; } object args = copyObject(PROC_COMP_ARGS(procedure)); object body = copyObject(PROC_COMP_BODY(procedure)); if (listLength(parameters) != listLength(args)) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; return result; } if (!createTable()) { deleteObject(args); deleteObject(body); TYPE(result) = errorObject; ERR(result) = maxRecursionDepthError; return result; } object *currentArg = &args; object *currentParam = ¶meters; while (TYPE(*currentArg) != nilObject) { addSymbolVariable(SYM(CAR(*currentArg)), CAR(*currentParam)); currentArg = &CDR(*currentArg); currentParam = &CDR(*currentParam); } object *currentSubProc = &body; while (TYPE(*currentSubProc) != nilObject) { CAR(*currentSubProc) = eval(CAR(*currentSubProc)); if (TYPE(CDR(*currentSubProc)) == nilObject) { result = CAR(*currentSubProc); } currentSubProc = &CDR(*currentSubProc); } deleteObject(args); deleteObject(body); removeTable(); return result; }