kayprish/cirilisp
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Омогућена делимична елиминација репних позива, измењена "примени" функција

Browse source
This commit is contained in:
kappa 2019-08-25 14:34:38 +02:00
parent b136002d40
commit a765bf886f
5 changed files with 153 additions and 89 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Makefile
View file

@ -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

199
eval.c
View file

@ -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(&currentExpr); ова функција ће бити коришћена за
// упроштавање израза, тако да постану репно-елиминалбилни, када буде
// написана ЛОЛ :)
currentExpr = Eval(currentExpr, procEnv);
result = copyObject(currentExpr);
removeEnvironment(procEnv);
deleteObject(procedure);
deleteObject(parameters);
--currentRecursionDepth;
return result;
input = currentExpr;
currentEnv = procEnv;
tailExpression = 1;
goto eval;
}

21
internals.c
View file

@ -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)

17
util.c
View file

@ -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;

1
util.h
View file

@ -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);