#include #include #include #include "util.h" #include "internals.h" int currentRecursionDepth = 0; #define MAXRECURSIONDEPTH 1000 object apply(object function, object parameters, env currentEnv); object eval(object input, env currentEnv) { object result; if (TYPE(input) == symbolObject) { result = referVariable(SYM(input), currentEnv); } 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), currentEnv); } object *currentCell = &input; int noErrors = 1; if (!specialForm) { while (TYPE(*currentCell) != nilObject) { CAR(*currentCell) = eval(CAR(*currentCell), currentEnv); 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), currentEnv); } } } else { result = copyObject(input); } deleteObject(input); return result; } object apply(object procedure, object parameters, env currentEnv) { object result; if (TYPE(procedure) != procedureObject) { TYPE(result) = errorObject; ERR(result) = notApplicableError; return result; } if (PROC_TYPE(procedure) == builtinProc) { object(*f)() = PROC_BUILTIN(procedure); if (f == define || f == lambda) { result = f(parameters, currentEnv); } else { result = f(parameters); } return result; } if (++currentRecursionDepth > MAXRECURSIONDEPTH) { --currentRecursionDepth; SIGERR(maxRecursionDepthError); } object args = copyObject(PROC_COMP_ARGS(procedure)); object body = copyObject(PROC_COMP_BODY(procedure)); env definitionEnv = PROC_COMP_ENV(procedure); if (listLength(parameters) != listLength(args)) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; return result; } env procEnv = createEnvironment(definitionEnv); object *currentArg = &args; object *currentParam = ¶meters; while (TYPE(*currentArg) != nilObject) { addSymbolVariable(SYM(CAR(*currentArg)), CAR(*currentParam), procEnv); currentArg = &CDR(*currentArg); currentParam = &CDR(*currentParam); } object *currentSubProc = &body; while (TYPE(*currentSubProc) != nilObject) { CAR(*currentSubProc) = eval(CAR(*currentSubProc), procEnv); if (TYPE(CDR(*currentSubProc)) == nilObject) { result = copyObject(CAR(*currentSubProc)); } currentSubProc = &CDR(*currentSubProc); } deleteObject(args); deleteObject(body); removeEnvironment(procEnv); --currentRecursionDepth; return result; }