From 31e9a82704455dd92cfeef878456493c47cac63b Mon Sep 17 00:00:00 2001 From: Felix Perktold Date: Sun, 18 Jan 2026 18:39:19 +0100 Subject: factor out basic standard procedures (+, -, cons, car...) into separate module --- lisp.c | 155 ----------------------------------------------------------------- 1 file changed, 155 deletions(-) (limited to 'lisp.c') diff --git a/lisp.c b/lisp.c index 88ff472..e1f09dd 100644 --- a/lisp.c +++ b/lisp.c @@ -334,161 +334,6 @@ value *apply(value *lval, value *args) { return make_lambda(sub_env, params, lval->as.lambda.body); } -value *procedure_cons(env *e, value *args) { - value *v = eval(e, car(args)); - return cons(v, eval(e, car(cdr(args)))); -} - -value *procedure_car(env *e, value *args) { - return car(eval(e, car(args))); -} - -value *procedure_cdr(env *e, value *args) { - return cdr(eval(e, car(args))); -} - -value *procedure_reverse(env *e, value *args) { - return reverse(eval(e, car(args))); -} - -value *procedure_isnull(env *e, value *args) { - value *v = eval(e, car(args)); - if(v->type == VT_NIL) { - return make_int(1); - } - return make_nil(); -} - -int value_eq(value *a, value *b) { - if(a->type != b->type){ - return 0; - } - if(a == b){ - return 1; - } - switch (a->type) { - case VT_INT: return a->as.i == b->as.i; - case VT_DOUBLE: return a->as.d == b->as.d; - case VT_SYMBOL: return !strcmp(a->as.sym, b->as.sym); - case VT_STRING: return !strcmp(a->as.sym, b->as.sym); - case VT_NIL: return 1; - case VT_PAIR: - return value_eq(car(a), car(b)) && - value_eq(cdr(a), cdr(b)); - case VT_LAMBDA: - case VT_PROCEDURE: - default: - return 0; - } - return 1; -} - -value *procedure_equal(env *e, value *args) { - value *v_prev = eval(e, car(args)); - - args = cdr(args); - while (args->type == VT_PAIR) { - value *v_cur = eval(e, car(args)); - if (!value_eq(v_prev, v_cur)) { - return make_nil(); - } - v_prev = v_cur; - args = cdr(args); - } - - return make_int(1); -} - -value *apply_to_nums(env *e, value *args, double (*fn)(double, double)) { - double result; - value *v = eval(e, car(args)); - if (v->type == VT_INT) { - result = v->as.i; - } else if (v->type == VT_DOUBLE) { - result = v->as.d; - } else { - printf("not a number: "); - println_value(v); - return make_nil(); - } - - args = cdr(args); - while (args->type == VT_PAIR) { - v = eval(e, car(args)); - if (v->type == VT_INT) { - result = fn(result, v->as.i); - } else if (v->type == VT_DOUBLE) { - result = fn(result, v->as.d); - } else { - printf("not a number: "); - println_value(v); - return make_nil(); - } - args = cdr(args); - } - - if(is_integer(result)){ - return make_int((int) result); - } - return make_double(result); -} - -double add_fn(double x, double y) { return x+y; } -value *procedure_add(env *e, value *args) { - return apply_to_nums(e, args, add_fn); -} - -double sub_fn(double x, double y) { return x-y; } -value *procedure_sub(env *e, value *args) { - return apply_to_nums(e, args, sub_fn); -} - -double mul_fn(double x, double y) { return x*y; } -value *procedure_mul(env *e, value *args) { - return apply_to_nums(e, args, mul_fn); -} - -double div_fn(double x, double y) { return x/y; } -value *procedure_div(env *e, value *args) { - return apply_to_nums(e, args, div_fn); -} - -value *procedure_lt(env *e, value *args) { - double prev_num; - value *v = eval(e, car(args)); - - if (v->type == VT_INT) { - prev_num = v->as.i; - } else if (v->type == VT_DOUBLE) { - prev_num = v->as.d; - } else { - printf("not a number: "); - println_value(v); - return make_nil(); - } - - args = cdr(args); - while (args->type == VT_PAIR) { - v = eval(e, car(args)); - double cur_num; - if (v->type == VT_INT) { - cur_num = v->as.i; - } else if (v->type == VT_DOUBLE) { - cur_num = v->as.d; - } else { - printf("not a number: "); - println_value(v); - return make_nil(); - } - if(prev_num >= cur_num) { - return make_nil(); - } - prev_num = cur_num; - args = cdr(args); - } - return make_int(1); -} - value *procedure_load_module(env *e, value *args) { value *fst_arg = eval(e, car(args)); -- cgit v1.2.3