#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); 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 Eval(object input, env currentEnv) { object result; int tailExpression = 0, macroEvalPending; eval: macroEvalPending = 0; 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) { goto apply; } } else { if (TYPE(CAR(input)) == procedureObject && PROC_SPECIAL(CAR(input)) && PROC_TYPE(CAR(input)) == compoundProc) { macroEvalPending = 1; } goto apply; // big problem pendejo } } } else { result = copyObject(input); } if (tailExpression) { removeEnvironment(currentEnv); } deleteObject(input); return result; object procedure, parameters; apply: procedure = copyObject(CAR(input)); parameters = copyObject(CDR(input)); deleteObject(input); if (tailExpression && PROC_TYPE(procedure) != builtinProc && !macroEvalPending) { removeEnvironment(currentEnv); } if (TYPE(procedure) != procedureObject) { deleteObject(procedure); deleteObject(parameters); SIGERR(notApplicableError); } if (PROC_TYPE(procedure) == builtinProc) { object(*f)() = PROC_BUILTIN(procedure); if (f == defineInt || f == lambdaInt || f == ifInt || f == applyInt || f == defineMacroInt) { result = f(parameters, currentEnv); } else { result = f(parameters); } if (tailExpression) { removeEnvironment(currentEnv); } deleteObject(procedure); deleteObject(parameters); return result; } if (++currentRecursionDepth > maxRecursionDepth) { --currentRecursionDepth; deleteObject(procedure); deleteObject(parameters); 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); deleteObject(procedure); deleteObject(parameters); SIGERR(argumentNumberError); } object *currentExprPointer = &PROC_COMP_BODY(procedure); object currentExpr; while (TYPE(CDR(*currentExprPointer)) != nilObject) /* сви изрази осим задњег */ { currentExpr = copyObject(CAR(*currentExprPointer)); currentExpr = Eval(currentExpr, procEnv); deleteObject(currentExpr); currentExprPointer = &CDR(*currentExprPointer); } /* репни позив */ currentExpr = copyObject(CAR(*currentExprPointer)); //pruneExpr(¤tExpr); ова функција ће бити коришћена за // упроштавање израза, тако да постану репно-елиминалбилни, када буде // написана ЛОЛ :) deleteObject(procedure); deleteObject(parameters); --currentRecursionDepth; input = currentExpr; if (macroEvalPending) { input = Eval(input, procEnv); removeEnvironment(procEnv); } else { currentEnv = procEnv; tailExpression = 1; } goto eval; }