shithub: femtolisp

Download patch

ref: 43b6029727e8c5443720c1dadbca2c92b4295b54
parent: 332235231c0d230e1ea93e943e32e1b33ff79989
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Wed Aug 12 01:15:21 EDT 2009

allowing form (define x)
error checking define a bit better
fixing a small bug in expand-lambda


--- a/femtolisp/compiler.lsp
+++ b/femtolisp/compiler.lsp
@@ -426,11 +426,18 @@
 			(compile-builtin-call g env tail? x head b nargs)
 			(emit g (if tail? 'tcall 'call) nargs))))))))))
 
-(define (expand-define form body)
-  (if (symbol? form)
-      `(set! ,form ,(car body))
-      `(set! ,(car form)
-	     (lambda ,(cdr form) ,@body . ,(car form)))))
+(define (expand-define x)
+  (let ((form (cadr x))
+	(body (if (pair? (cddr x))
+		  (cddr x)
+		  (if (symbol? (cadr x))
+		      '(#f)
+		      (error "compile error: invalid syntax "
+			     (print-to-string x))))))
+    (if (symbol? form)
+	`(set! ,form ,(car body))
+	`(set! ,(car form)
+	       (lambda ,(cdr form) ,@body . ,(car form))))))
 
 (define (fits-i8 x) (and (fixnum? x) (>= x -128) (<= x 127)))
 
@@ -470,7 +477,7 @@
 	   (set!     (compile-in g env #f (caddr x))
 		     (compile-sym g env (cadr x) [seta setc setg]))
 	   (define   (compile-in g env tail?
-				 (expand-define (cadr x) (cddr x))))
+				 (expand-define x)))
 	   (trycatch (compile-in g env #f `(lambda () ,(cadr x)))
 		     (unless (1arg-lambda? (caddr x))
 			     (error "trycatch: second form must be a 1-argument lambda"))
--- a/femtolisp/system.lsp
+++ b/femtolisp/system.lsp
@@ -735,7 +735,7 @@
      (lastcdr l)))
   
   (define (l-vars l)
-    (cond ((atom? l) l)
+    (cond ((atom? l) (list l))
 	  ((pair? (car l)) (cons (caar l) (l-vars (cdr l))))
 	  (else (cons (car l) (l-vars (cdr l))))))
   
@@ -787,7 +787,9 @@
 	       (default (lambda ()
 			  (let loop ((e e))
 			    (if (atom? e) e
-				(cons (expand-in (car e) env)
+				(cons (if (atom? (car e))
+					  (car e)
+					  (expand-in (car e) env))
 				      (loop (cdr e))))))))
 	  (cond ((and bnd (pair? (cdr bnd)))  ; local macro
 		 (expand-in (apply (cadr bnd) (cdr e))