diff --git a/kekkonen.scm b/kekkonen.scm index b26d2a4..6519271 100644 --- a/kekkonen.scm +++ b/kekkonen.scm @@ -339,9 +339,9 @@ (cond ((procedure? function) (apply function args)) ((list? function) - (let ((function-arguments (cadr function)) - (function-body (cddr function))) - (lisp function-body (cons (if (= (length function-arguments) (length argument-values)) + (let ((function-arguments (car function)) + (function-body (cdr function))) + (lisp function-body (cons (if (= (length function-arguments) (length args)) (map cons function-arguments args) (lisp-exit "Wrong number of arguments to function")) environments) lisp-exit))) (else (lisp-exit "attempt to call atom")))) @@ -349,8 +349,7 @@ (define (lisp-eval body) (cond ((symbol? body) (reference body)) ((atom? body) body) - ((list? body) (let ((ln (map lisp-eval body))) - (lisp-apply (car ln) (cdr ln)))) + ((list? body) (lisp-apply (lisp-eval (car body)) (cdr body))) (else (lisp-exit "Unknown value type in evaluation.")))) (define (bind name value) @@ -377,41 +376,48 @@ (_ (lisp-exit "malformed quote expression"))))) (cons . ,(lambda function-args (match function-args - ((a b) (cons a b)) + ((a b) (cons (lisp-eval a) (lisp-eval b))) (_ (lisp-exit "malformed cons expression"))))) (car . ,(lambda function-args (match function-args - ((a) (if (atom? a) - (lisp-exit "tried to take car of atom") - (car a))) + ((a) (let ((e (lisp-eval a))) + (if (atom? e) + (lisp-exit "tried to take car of atom") + (car e)))) (_ (lisp-exit "malformed car expression"))))) (cdr . ,(lambda function-args (match function-args - ((a) (if (atom? a) - (lisp-exit "tried to take cdr of atom") - (cdr a))) + ((a) (let ((e (lisp-eval a))) + (if (atom? e) + (lisp-exit "tried to take cdr of atom") + (cdr e)))) (_ (lisp-exit "malformed cdr expression"))))) (atom . ,(lambda function-args (match function-args - ((a) (atom? a)) + ((a) (let ((e (lisp-eval a))) + (atom? e))) (_ (lisp-exit "malformed atom expression"))))) (eq . ,(lambda function-args (match function-args - ((a b) (equal? a b)) + ((a b) (let ((ea (eval a)) + (eb (eval b))) + (equal? ea eb))) (_ (lisp-exit "malformed eq expression"))))) (set . ,(lambda function-args (match function-args - ((a b) (if (symbol? a) - (bind a b) - (lisp-exit "tried to bind to non-symbol"))) + ((a b) (let ((ea (eval a)) + (eb (eval b))) + (if (symbol? a) + (bind a b) + (lisp-exit "tried to bind to non-symbol")))) (_ (lisp-exit "malformed set expression"))))) (lambda . ,(lambda function-args (match function-args ((args exp . exps) (if (and (list? args) (every symbol? args)) (cons args (cons exp exps)) - (lisp-exit "malformed lambda expression")) - (_ (lisp-exit "malformed lambda expression")))))))) + (lisp-exit "malformed lambda expression"))) + (_ (lisp-exit "malformed lambda expression"))))))) (lisp-eval body))