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