lambda

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))