EvalRes prim(const char *s, char **s1, int d) {
// printf("Getting prim from `%s`\n", s);
Token tok = get_token(s, s1);
if (tok.st == InvalidToken)
return everr(InvalidToken);
if (tok.t == NUM) {
return evdone(tok.val);
}
if (tok.t == MINUS) {
char *s2 = *s1;
Token tok2 = get_token(*s1, s1);
if (tok2.t != NUM && tok2.t != LP)
return everr(SyntaxError);
else
*s1 = s2;
return neg_res(prim(*s1, s1, d));
}
if (tok.t == LP) {
EvalRes r = expr(*s1, s1, d + 1);
tok = get_token(*s1, s1);
if (tok.st == InvalidToken)
return everr(InvalidToken);
if (tok.t != RP)
return everr(SyntaxError);
return r;
}
// puts("Returning syntax error from prim");
return everr(SyntaxError);
}
/* Return the second element of a pair */
static exp_t *
prim_cdr(exp_t *args)
{
chkargs("cdr", args, 1);
if (!ispair(car(args)))
everr("cdr: the argument isn't a pair", car(args));
return cdar(args);
}
/* Evaluate the expressions inside the file pointed by ep */
static exp_t *
prim_load(exp_t *args)
{
chkargs("load", args, 1);
if (!isstr(car(args)))
everr("load: should be a string", car(args));
load(str(car(args)), NINTER);
return NULL;
}
/* Return the division of the expressions */
static exp_t *
prim_div(exp_t *args)
{
if (isnull(args))
everr("/: need at least one argument -- given", null);
else if(isnull(cdr(args)))
return divs(nfixnum(1), car(args));
return foldl(divs, car(args), cdr(args));
}
/* Return the cumulated substraction of the arguments */
static exp_t *
prim_sub(exp_t *args)
{
if (isnull(args))
everr("- : need at least one argument, given", null);
else if (isnull(cdr(args)))
return sub(nfixnum(0), car(args));
return foldl(sub, car(args), cdr(args));
}
/* Return the natural logarithm of the expression */
static exp_t *
prim_log(exp_t *args)
{
double v = 0.0;
chkargs("log", args, 1);
if (!isnum(car(args)) || (v = VALUE(car(args))) <= 0)
everr("log : not a positive number", car(args));
return nfloat(log(v));
}
EvalRes term(const char *s, char **s1, int d) {
// printf("Getting term from `%s`\n", s);
EvalRes p = prim(s, s1, d);
char *s2 = *s1;
Token sgn = get_token(*s1, s1);
if (sgn.st == InvalidToken)
return everr(InvalidToken);
if (sgn.t == MUL)
return mul_res(p, term(*s1, s1, d));
else if (sgn.t == DIV)
return div_res(p, term(*s1, s1, d));
else if (sgn.t == END || sgn.t == RP || sgn.t == MINUS || sgn.t == PLUS) {
if (sgn.t == RP && d <= 0)
return everr(SyntaxError);
*s1 = s2;
return p;
} else
return everr(SyntaxError);
}
/* Apply a procedure expression to a list of expressions */
static exp_t *
prim_apply(exp_t *args)
{
exp_t *op, *prev, *last;
if (isnull(args) || isnull(cdr(args)))
everr("apply: expects at least 2 arguments, given", args);
op = car(args);
if (!isnull(last = cddr(args))) {
for (prev = cdr(args); !isnull(cdr(last)); last = cdr(last))
prev = last;
cdr(prev) = car(last);
args = cdr(args);
} else {
last = cdr(args);
args = car(last);
}
if (!islist(car(last)))
everr("apply: should be a proper list", car(last));
return apply(op, args);
}
EvalRes expr(const char *s, char **s1, int d) {
// printf("Getting expr from `%s`\n", s);
EvalRes t = term(s, s1, d);
if (t.st != EvalOk)
return t;
char *s2 = *s1;
Token sgn = get_token(*s1, s1);
if (sgn.st == InvalidToken)
return everr(InvalidToken);
if (sgn.t == PLUS)
return add_res(t, expr(*s1, s1, d));
else if (sgn.t == MINUS) {
*s1 = s2;
return add_res(t, expr(*s1, s1, d));
} else if (sgn.t == END || sgn.t == RP) {
if (sgn.t == RP && d <= 0)
return everr(SyntaxError);
*s1 = s2;
return t;
} else
return everr(SyntaxError);
}
/* Return the division of two expressions */
static exp_t *
divs(exp_t *a1, exp_t *a2)
{
exp_t *res;
CHKNUM(a1, /);
CHKNUM(a2, /);
if (VALUE(a2) == 0)
everr("/: argument is divided by zero", a1);
if (isfloat(a1) || isfloat(a2))
res = nfloat(VALUE(a1) / VALUE(a2));
else
res = nrat(NUMER(a1) * DENOM(a2), NUMER(a2) * DENOM(a1));
return res;
}
