adding named let

This commit is contained in:
JeffBezanson 2009-02-06 03:41:24 +00:00
parent 2c1bb59486
commit 2a083db293
1 changed files with 22 additions and 5 deletions

View File

@ -40,10 +40,22 @@
(cons (f (car lst)) (map f (cdr lst))))) (cons (f (car lst)) (map f (cdr lst)))))
(define-macro (let binds . body) (define-macro (let binds . body)
(cons (list 'lambda ((lambda (lname)
(map (lambda (c) (if (pair? c) (car c) c)) binds) (begin
(f-body body)) (if (symbol? binds)
(map (lambda (c) (if (pair? c) (cadr c) #f)) binds))) (begin (set! lname binds)
(set! binds (car body))
(set! body (cdr body))))
((lambda (thelambda theargs)
(cons (if lname
(list 'label lname thelambda)
thelambda)
theargs))
(list 'lambda
(map (lambda (c) (if (pair? c) (car c) c)) binds)
(f-body body))
(map (lambda (c) (if (pair? c) (cadr c) #f)) binds))))
#f))
(define (nconc . lsts) (define (nconc . lsts)
(cond ((null? lsts) ()) (cond ((null? lsts) ())
@ -142,7 +154,7 @@
(macroexpand (list 'lambda (cdr form) (f-body body))))) (macroexpand (list 'lambda (cdr form) (f-body body)))))
(define macroexpand (macroexpand macroexpand)) (define macroexpand (macroexpand macroexpand))
(define = equal) (define = eqv)
(define eql eqv) (define eql eqv)
(define (/= a b) (not (equal a b))) (define (/= a b) (not (equal a b)))
(define != /=) (define != /=)
@ -522,3 +534,8 @@
(table.foldl (lambda (k v z) (put! nt k v)) (table.foldl (lambda (k v z) (put! nt k v))
() t) () t)
nt)) nt))
(define *whitespace*
(string.encode #array(wchar 9 10 11 12 13 32 133 160 5760 6158 8192
8193 8194 8195 8196 8197 8198 8199 8200
8201 8202 8232 8233 8239 8287 12288)))