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-09-21 10:53:37 +02:00
parent a876c02003
commit 43dcc68547
3 changed files with 97 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
cirilisp.c
View file

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

141
eval.c
View file

@ -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 = &parameters;
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(&currentExpr); ова функција ће бити коришћена за
// упроштавање израза, тако да постану репно-елиминалбилни, када буде
// написана ЛОЛ :)
deleteObject(procedure);
deleteObject(parameters);

15
internals.c
View file

@ -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 = &parameters;
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;
}