From e6aeef5e54759c26912c4987cb86b3add2d77349 Mon Sep 17 00:00:00 2001 From: Felix Perktold Date: Tue, 13 Jan 2026 14:16:10 +0100 Subject: added some lisp functions --- Makefile | 3 +++ lisp.c | 8 ++++++-- lisp/standard_functions.lisp | 40 +++++++++++++++++++++++++++++++++++++--- 3 files changed, 46 insertions(+), 5 deletions(-) diff --git a/Makefile b/Makefile index 095a7ae..a04723e 100644 --- a/Makefile +++ b/Makefile @@ -37,4 +37,7 @@ test.o: test.c lisp.h lex.yy.o run: main ./main +run_std: main + ./main lisp/standard_functions.lisp + .PHONY: clean test run diff --git a/lisp.c b/lisp.c index a559330..4e143f1 100644 --- a/lisp.c +++ b/lisp.c @@ -222,7 +222,7 @@ value *eval(env *e, value *v) { if (!found) { printf("symbol %s not found\n", v->as.sym); return cons(make_symbol("quote"), - cons(v, make_nil())); + cons(v, make_nil())); //TODO: return error } return found; } @@ -318,9 +318,13 @@ value *apply(value *lval, value *args) { value *result = eval(sub_env, lval->as.lambda.body); // if arguments left, try applying them to evaluated lambda - if (arg->type == VT_PAIR) { + if (arg->type == VT_PAIR && result->type == VT_LAMBDA) { return apply(result, arg); } + // if arguments left but result is not a lambda, explicitely return false TODO: return an error + if (arg->type == VT_PAIR) { + return make_nil(); + } return result; } diff --git a/lisp/standard_functions.lisp b/lisp/standard_functions.lisp index 9658ef9..5ad4298 100644 --- a/lisp/standard_functions.lisp +++ b/lisp/standard_functions.lisp @@ -1,15 +1,49 @@ -; comparisons +;; comparisons (define <= (lambda (x y) (if (< x y) 1 - (if (eq? x y) 1 ())))) + (if (equal? x y) 1 ())))) (define > (lambda (x y) (< y x))) (define >= (lambda (x y) (<= y x))) -; boolean funs +(define even? (lambda (n) + (if (equal? n 0) + 1 + (odd? (- n 1))))) + +(define odd? (lambda (n) + (if (equal? n 0) + () + (even? (- n 1))))) +;; boolean funs (define and (lambda (x y) (if x (if y 1 ()) ()))) (define or (lambda (x y) (if x 1 y))) +(define xor (lambda (x y) (if x (null? y) y))) (define nand (lambda (x y) (null? (and x y)))) + +;; common recursive functions +(define ! (lambda (n) + (if (equal? n 0) + 1 + (* n + (! (- n 1)))))) + +(define fib (lambda (n) + (if (<= n 2) + 1 + (+ (fib (- n 1)) + (fib (- n 2)))))) + +(define ack (lambda (n m) + (if (equal? n 0) + (+ m 1) + (if (equal? m 0) + (print (ack (print (- n 1)) (print 1))) + (ack (- n 1) (ack n (- m 1))))))) + +(define seq (lambda (n) + (seq (print (+ n 1))))) + -- cgit v1.2.3