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