From 43dcc68547f063a3705b8c97703843057a608fcb Mon Sep 17 00:00:00 2001 From: kappa Date: Sat, 21 Sep 2019 10:53:37 +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=BF=D0=BE=D1=82=D0=BF=D1=83=D0=BD=D0=B0=20?= =?UTF-8?q?=D1=80=D0=B5=D0=BF=D0=BD=D0=B0=20=D0=B5=D0=BB=D0=B8=D0=BC=D0=B8?= =?UTF-8?q?=D0=BD=D0=B0=D1=86=D0=B8=D1=98=D0=B0,=20"=D0=BF=D0=BE=D1=87?= =?UTF-8?q?=D0=BD=D0=B8"=20=D1=98=D0=B5=20=D1=81=D0=B0=D0=B4=D0=B0=20?= =?UTF-8?q?=D1=81=D0=BF=D0=B5=D1=86=D0=B8=D1=98=D0=B0=D0=BB=D0=BD=D0=B0=20?= =?UTF-8?q?=D1=84=D0=BE=D1=80=D0=BC=D0=B0,=20=D0=BF=D0=BE=D0=BD=D0=B0?= =?UTF-8?q?=D1=88=D0=B0=D1=9A=D0=B5=20=D1=98=D0=B5=20=D0=BD=D0=B5=D0=BF?= =?UTF-8?q?=D1=80=D0=BE=D0=BC=D0=B5=D1=9A=D0=B5=D0=BD=D0=BE?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- cirilisp.c | 2 +- eval.c | 141 +++++++++++++++++++++++++++++++--------------------- internals.c | 15 +++++- 3 files changed, 97 insertions(+), 61 deletions(-) diff --git a/cirilisp.c b/cirilisp.c index 6d202ee..8429c87 100644 --- a/cirilisp.c +++ b/cirilisp.c @@ -93,7 +93,7 @@ void init() addSymbolInternal("нетачно->тачно", &inexactToExactInt, 0); addSymbolInternal("опиши", &defineInt, 1); addSymbolInternal("опиши-складњу", &defineMacroInt, 1); - addSymbolInternal("почни", &beginInt, 0); + addSymbolInternal("почни", &beginInt, 1); addSymbolInternal("ниска?", &stringQInt, 0); addSymbolInternal("сар", &carInt, 0); addSymbolInternal("разломак?", &fractionQInt, 0); diff --git a/eval.c b/eval.c index 95e4b11..9292dba 100644 --- a/eval.c +++ b/eval.c @@ -81,61 +81,56 @@ eval: deleteObject(input); SIGERR(improperListError); } + + 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 { - 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))) + PROC_SPECIAL(CAR(input)) && + PROC_TYPE(CAR(input)) == compoundProc) { - 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 + macroEvalPending = 1; } + goto apply; } } else @@ -155,7 +150,8 @@ apply: procedure = copyObject(CAR(input)); parameters = copyObject(CDR(input)); deleteObject(input); - if (tailExpression && PROC_TYPE(procedure) != builtinProc && !macroEvalPending) + if (tailExpression && PROC_TYPE(procedure) != builtinProc && + !macroEvalPending) { removeEnvironment(currentEnv); } @@ -171,8 +167,35 @@ apply: if (PROC_TYPE(procedure) == builtinProc) { object(*f)() = PROC_BUILTIN(procedure); + + if (f == ifInt) + { + if (listLength(parameters) >= 2) + { + CAR(CDR(parameters)) = + quoteExpression(CAR(CDR(parameters))); + } + if (listLength(parameters) >= 3) + { + CAR(CDR(CDR(parameters))) = + quoteExpression(CAR(CDR(CDR(parameters)))); + } + } + else if (f == beginInt) + { + if (listLength(parameters) >= 1) + { + object *current = ¶meters; + while (TYPE(CDR(*current)) != nilObject) + { + current = &CDR(*current); + } + CAR(*current) = quoteExpression(CAR(*current)); + } + } + if (f == defineInt || f == lambdaInt || f == ifInt || - f == applyInt || f == defineMacroInt) + f == applyInt || f == defineMacroInt || f == beginInt) { result = f(parameters, currentEnv); } @@ -181,13 +204,18 @@ apply: result = f(parameters); } - if (tailExpression) + deleteObject(procedure); + deleteObject(parameters); + if (f == beginInt || f == ifInt) + { + input = result; + goto eval; + } + else if (tailExpression) { removeEnvironment(currentEnv); } - deleteObject(procedure); - deleteObject(parameters); return result; } @@ -225,9 +253,6 @@ apply: } /* репни позив */ currentExpr = copyObject(CAR(*currentExprPointer)); - //pruneExpr(¤tExpr); ова функција ће бити коришћена за - // упроштавање израза, тако да постану репно-елиминалбилни, када буде - // написана ЛОЛ :) deleteObject(procedure); deleteObject(parameters); diff --git a/internals.c b/internals.c index c6170fb..a97d357 100644 --- a/internals.c +++ b/internals.c @@ -837,7 +837,7 @@ object readInt(object parameters) return Read("", stdin); } -object beginInt(object parameters) +object beginInt(object parameters, env currentEnv) { object last; if (listLength(parameters) == 0) @@ -847,11 +847,22 @@ object beginInt(object parameters) else { object *current = ¶meters; + object currentResult; while (TYPE(CDR(*current)) != nilObject) { + currentResult = Eval(copyObject(CAR(*current)), currentEnv); + if (TYPE(currentResult) == errorObject) + { + CPYERR(ERR(currentResult)); + } + current = &CDR(*current); } - last = copyObject(CAR(*current)); + last = Eval(copyObject(CAR(*current)), currentEnv); + if (TYPE(last) == errorObject) + { + CPYERR(ERR(last)); + } } return last; }