#include #include #include #include "util.h" #include "internals.h" #include "eval.h" int currentRecursionDepth = 0; int maxRecursionDepth = 10000; 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)) { deleteObject(input); SIGERR(improperListError); } else { int regularEvalOrder = 1; CAR(input) = Eval(CAR(input), currentEnv); if (TYPE(CAR(input)) == errorObject) { result = copyObject(CAR(input)); deleteObject(input); CPYERR(ERR(result)); } if (TYPE(CAR(input)) == procedureObject && PROC_SPECIAL(CAR(input))) { regularEvalOrder = 0; } object *currentCell = &CDR(input); int noErrors = 1; if (regularEvalOrder) { while (TYPE(*currentCell) != nilObject) { CAR(*currentCell) = Eval(CAR(*currentCell), currentEnv); if (TYPE(CAR(*currentCell)) == errorObject) { noErrors = 0; object err = copyObject( CAR(*currentCell)); deleteObject(input); CPYERR(ERR(err)); break; } currentCell = &CDR(*currentCell); } } if (noErrors) { result = apply(CAR(input), CDR(input), currentEnv); } if (TYPE(CAR(input)) == procedureObject && PROC_SPECIAL(CAR(input)) && PROC_TYPE(CAR(input)) == compoundProc) { result = Eval(result, currentEnv); } } } else { result = copyObject(input); } deleteObject(input); return result; } int bindArgs(object parameters, object args, env newEnv) /* на почетку извршавања функције, везује прослеђене параметре, за симболе у * дефиницији функције, везивање се врши у новонасталом окружењу, уколико је * параметри нису правилни за дате аргументе, враћа 0, уколико нема грешке * враћа 1 */ { if (properList(args)) /* уколико је листа аргумената правилна, број аргумената је одређен */ { if (listLength(parameters) != listLength(args)) { return 0; } else { object *currentArg = &args; object *currentParam = ¶meters; while (TYPE(*currentArg) != nilObject) { addSymbolVariable(SYM(CAR(*currentArg)), CAR(*currentParam), newEnv); currentArg = &CDR(*currentArg); currentParam = &CDR(*currentParam); } return 1; } } else /* у супротном, број аргумената је само ограничен одоздо */ { if (improperListLength(args) - 1 > listLength(parameters)) { return 0; } else { object *currentArg = &args; object *currentParam = ¶meters; while (TYPE(*currentArg) == consObject) { addSymbolVariable(SYM(CAR(*currentArg)), CAR(*currentParam), newEnv); currentArg = &CDR(*currentArg); currentParam = &CDR(*currentParam); } addSymbolVariable(SYM(*currentArg), *currentParam, newEnv); return 1; } } } object apply(object procedure, object parameters, env currentEnv) { object result; if (TYPE(procedure) != procedureObject) { SIGERR(notApplicableError); } if (PROC_TYPE(procedure) == builtinProc) { object(*f)() = PROC_BUILTIN(procedure); if (f == defineInt || f == lambdaInt || f == ifInt || f == applyInt) { result = f(parameters, currentEnv); } else { result = f(parameters); } return result; } if (++currentRecursionDepth > maxRecursionDepth) { --currentRecursionDepth; SIGERR(maxRecursionDepthError); } object args = PROC_COMP_ARGS(procedure); env definitionEnv = PROC_COMP_ENV(procedure); env procEnv = createEnvironment(definitionEnv); if (!bindArgs(parameters, args, procEnv)) { deleteObject(args); removeEnvironment(procEnv); SIGERR(argumentNumberError); } object *currentExprPointer = &PROC_COMP_BODY(procedure); while (TYPE(*currentExprPointer) != nilObject) { object currentExpr = copyObject(CAR(*currentExprPointer)); currentExpr = Eval(currentExpr, procEnv); if (TYPE(CDR(*currentExprPointer)) == nilObject) { result = copyObject(currentExpr); } currentExprPointer = &CDR(*currentExprPointer); deleteObject(currentExpr); } removeEnvironment(procEnv); --currentRecursionDepth; return result; }