From a765bf886f350f76195e5e6bbbe561b1436cd8b8 Mon Sep 17 00:00:00 2001 From: kappa Date: Sun, 25 Aug 2019 14:34:38 +0200 Subject: [PATCH] =?UTF-8?q?=D0=9E=D0=BC=D0=BE=D0=B3=D1=83=D1=9B=D0=B5?= =?UTF-8?q?=D0=BD=D0=B0=20=D0=B4=D0=B5=D0=BB=D0=B8=D0=BC=D0=B8=D1=87=D0=BD?= =?UTF-8?q?=D0=B0=20=D0=B5=D0=BB=D0=B8=D0=BC=D0=B8=D0=BD=D0=B0=D1=86=D0=B8?= =?UTF-8?q?=D1=98=D0=B0=20=D1=80=D0=B5=D0=BF=D0=BD=D0=B8=D1=85=20=D0=BF?= =?UTF-8?q?=D0=BE=D0=B7=D0=B8=D0=B2=D0=B0,=20=D0=B8=D0=B7=D0=BC=D0=B5?= =?UTF-8?q?=D1=9A=D0=B5=D0=BD=D0=B0=20"=D0=BF=D1=80=D0=B8=D0=BC=D0=B5?= =?UTF-8?q?=D0=BD=D0=B8"=20=D1=84=D1=83=D0=BD=D0=BA=D1=86=D0=B8=D1=98?= =?UTF-8?q?=D0=B0?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Makefile | 4 +- eval.c | 199 +++++++++++++++++++++++++++++----------------------- internals.c | 21 +++++- util.c | 17 +++++ util.h | 1 + 5 files changed, 153 insertions(+), 89 deletions(-) diff --git a/Makefile b/Makefile index 260ffca..7dc9d9c 100644 --- a/Makefile +++ b/Makefile @@ -9,8 +9,8 @@ LIBPREFIX = $(PREFIX)/lib # флегови за C компајлер и линкер CPPFLAGS = -D_POSIX_C_SOURCE=2 -DDESTDIR=\"$(DESTDIR)\" -DVERSION=\"$(VERSION)\" -# CFLAGS = -g -std=c99 -pedantic -Wall -Wextra -O0 -fexec-charset=UTF-8 -finput-charset=UTF-8 -fwide-exec-charset=UTF-32LE -CFLAGS = -std=c99 -pedantic -Wall -Wextra -O3 -fexec-charset=UTF-8 -finput-charset=UTF-8 -fwide-exec-charset=UTF-32LE +# CFLAGS = -g -std=c99 -pedantic -Wall -Wextra -Wno-maybe-uninitialized -O0 -fexec-charset=UTF-8 -finput-charset=UTF-8 -fwide-exec-charset=UTF-32LE +CFLAGS = -std=c99 -pedantic -Wall -Wextra -Wno-maybe-uninitialized -O3 -fexec-charset=UTF-8 -finput-charset=UTF-8 -fwide-exec-charset=UTF-32LE LDFLAGS = -lm -lc CC = cc diff --git a/eval.c b/eval.c index edf7958..9e2ab9a 100644 --- a/eval.c +++ b/eval.c @@ -11,85 +11,6 @@ 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) /* на почетку извршавања функције, везује прослеђене параметре, за симболе у * дефиницији функције, везивање се врши у новонасталом окружењу, уколико је @@ -142,12 +63,106 @@ int bindArgs(object parameters, object args, env newEnv) } } -object apply(object procedure, object parameters, env currentEnv) +object Eval(object input, env currentEnv) { object result; + int tailExpression = 0; + +eval: + 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 + { + goto apply; + if (TYPE(CAR(input)) == procedureObject && + PROC_SPECIAL(CAR(input)) && + PROC_TYPE(CAR(input)) == compoundProc) + { + result = Eval(result, currentEnv); + } + } + } + } + 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) + { + removeEnvironment(currentEnv); + } + if (TYPE(procedure) != procedureObject) { + deleteObject(procedure); + deleteObject(parameters); SIGERR(notApplicableError); } @@ -155,7 +170,7 @@ object apply(object procedure, object parameters, env currentEnv) { object(*f)() = PROC_BUILTIN(procedure); if (f == defineInt || f == lambdaInt || f == ifInt || - f == applyInt) + f == applyInt || f == defineMacroInt) { result = f(parameters, currentEnv); } @@ -164,12 +179,21 @@ object apply(object procedure, object parameters, env currentEnv) result = f(parameters); } + if (tailExpression) + { + removeEnvironment(currentEnv); + } + + deleteObject(procedure); + deleteObject(parameters); return result; } if (++currentRecursionDepth > maxRecursionDepth) { --currentRecursionDepth; + deleteObject(procedure); + deleteObject(parameters); SIGERR(maxRecursionDepthError); } @@ -181,6 +205,8 @@ object apply(object procedure, object parameters, env currentEnv) { deleteObject(args); removeEnvironment(procEnv); + deleteObject(procedure); + deleteObject(parameters); SIGERR(argumentNumberError); } @@ -200,11 +226,12 @@ object apply(object procedure, object parameters, env currentEnv) //pruneExpr(¤tExpr); ова функција ће бити коришћена за // упроштавање израза, тако да постану репно-елиминалбилни, када буде // написана ЛОЛ :) - currentExpr = Eval(currentExpr, procEnv); - result = copyObject(currentExpr); - removeEnvironment(procEnv); + deleteObject(procedure); + deleteObject(parameters); --currentRecursionDepth; - - return result; + input = currentExpr; + currentEnv = procEnv; + tailExpression = 1; + goto eval; } diff --git a/internals.c b/internals.c index e440e78..c6170fb 100644 --- a/internals.c +++ b/internals.c @@ -763,6 +763,8 @@ object eqvQInt(object parameters) object applyInt(object parameters, env currentEnv) { + object expression; + if (listLength(parameters) != 2) { SIGERR(argumentNumberError); @@ -772,7 +774,24 @@ object applyInt(object parameters, env currentEnv) { SIGERR(typeError); } - return apply(CAR(parameters), CAR(CDR(parameters)), currentEnv); + /* ово извршавање "примени" функције се врши тако што се "наводи" сваки + * појединачни члан листе параметара, и потом ствара комплетан израз + * који се евалуира, што укључује и примену функције, ово се чини јер + * по тренутном дизајну интерпретера засебна "примени" функција као + * таква не постоји */ + TYPE(expression) = consObject; + CONS(expression) = malloc(sizeof(cons)); + CAR(expression) = copyObject(CAR(parameters)); + CDR(expression) = copyObject(CAR(CDR(parameters))); + + object *current = &expression; + while (TYPE(*current) != nilObject) + { + CAR(*current) = quoteExpression(CAR(*current)); + current = &CDR(*current); + } + + return Eval(expression, currentEnv); } object displayInt(object parameters) diff --git a/util.c b/util.c index f397e8d..ac3a3f4 100644 --- a/util.c +++ b/util.c @@ -274,6 +274,23 @@ object copyObject(object input) return result; } +object quoteExpression(object input) +{ + object result; + + TYPE(result) = consObject; + CONS(result) = malloc(sizeof(cons)); + TYPE(CAR(result)) = symbolObject; + SYM(CAR(result)) = malloc(sizeof(char) * (strlen("навод") + 1)); + strcpy(SYM(CAR(result)), "навод"); + TYPE(CDR(result)) = consObject; + CONS(CDR(result)) = malloc(sizeof(cons)); + CAR(CDR(result)) = input; + TYPE(CDR(CDR(result))) = nilObject; + + return result; +} + object longlongToNumber(long long int input) { object result; diff --git a/util.h b/util.h index 0f81cbb..0214075 100644 --- a/util.h +++ b/util.h @@ -193,6 +193,7 @@ int improperListLength(object list); * као члан */ void deleteObject(object input); object copyObject(object input); +object quoteExpression(object input); object longlongToNumber(long long int input); object shortenFractionNum(object a);