nya

kekkonen.scm

@@ -327,6 +327,37 @@
 	      result
 	      (loop (cdr ln)))))))
 
+(define (lisp body environments exit)
+  (define (lisp-eval body)
+    (cond ((atom? body) body)
+	  ((symbol? body) (reference body))
+	  ((list? body) (let ((ln (map lisp-eval body)))
+			  (apply (car ln) (cdr ln))))
+	  (else (exit "Unknown value type in evaluation."))))
+  
+  (define (reference symbol)
+    (cdr (any-or (curry assoc symbol) environments (exit (string-append "Undefined reference: " (symbol->string symbol))))))
+  
+  (define (bind name value)
+    (set! environments (cons (let loop ((environment (car environments)))
+			       (if (null? environment)
+				   (list (cons name value))
+				   (if (eq? name (caar environment))
+				       (cons (cons name value) (cdr environment))
+				       (loop (cdr environment)))))
+			     (cdr environments))))
+				 
+  (define (lisp-apply function args)
+    (cond ((function? function)
+	   (apply function args))
+	  ((list? function)
+	   (let ((function-arguments (car function))
+		 (function-body (cddr function)))
+	     (lisp function-body (cons (if (= (length function-argumentsq) (length argument-values))
+					   (map cons function-arguments args)
+					   (exit "Wrong number of arguments to function")) environments) exit)))
+	  (_ (exit "attempt to call atom")))))
+
 (define lisp-builtins
   `((test . ,(lambda (function-args)
 	       (show "test function called")))
@@ -374,39 +405,6 @@
 		      (exit "malformed lambda expression"))
 		  (_ (exit "malformed lambda expression")))))))
 
-(define (lisp body environments exit)
-  (define (lisp-eval body)
-    (cond ((atom? body) body)
-	  ((symbol? body) (reference body))
-	  ((list? body) (let ((ln (map lisp-eval body)))
-			  (apply (car ln) (cdr ln))))
-	  (else (exit "Unknown value type in evaluation."))))
-  
-  (define (reference symbol)
-    (cdr (any-or (curry assoc symbol) environments (exit (string-append "Undefined reference: " (symbol->string symbol))))))
-  
-  (define (bind name value)
-    (set! environments (cons (let loop ((environment (car environments)))
-			       (if (null? environment)
-				   (list (cons name value))
-				   (if (eq? name (caar environment))
-				       (cons (cons name value) (cdr environment))
-				       (loop (cdr environment)))))
-			     (cdr environments))))
-				 
-  (define (lisp-apply function args)
-    (if (function? function)
-	(apply function args)
-	(case function-name
-	      (else (let ((function (reference function-name environments)))
-		      (let ((function-arguments (car function))
-			    (argument-values (cdr body))
-			    (function-body (cddr function)))
-			(lisp function-body (cons (if (= (length function-arguments) (length argument-values))
-						      (map cons function-arguments (map eval argument-values))
-						      (exit "Wrong number of arguments to function")) environments exit))))))
-	    (exit "attempt to call atom")))))	  
-
 (define (run-lisp body)
   (call/cc (lambda (exit)
 	     (cons #t (lisp body (list lisp-builtins) (compose exit (curry cons #f)))))))