add let* and letrec*

This commit is contained in:
Yuichi Nishiwaki 2013-11-14 13:17:54 +09:00
parent bc61cc4665
commit 0462aebce0
2 changed files with 59 additions and 13 deletions

View File

@ -137,6 +137,7 @@
(cons (f (car list))
(map f (cdr list)))))
;;; bootstrap
(define-macro (let bindings . body)
(cons (cons 'lambda (cons (map car bindings) body))
(map cadr bindings)))
@ -152,12 +153,6 @@
(define else #t)
(define-macro (when test . exprs)
(list 'if test (cons 'begin exprs) #f))
(define-macro (unless test . exprs)
(list 'if test #f (cons 'begin exprs)))
(define-macro (and . exprs)
(if (null? exprs)
#t
@ -187,6 +182,30 @@
(list 'quasiquote (cdr x))))))
(#t x)))
(define-macro (let* bindings . body)
(if (null? bindings)
`(let () ,@body)
`(let ((,(caar bindings)
,@(cdar bindings)))
(let* (,@(cdr bindings))
,@body))))
(define-macro (letrec bindings . body)
(let ((vars (map (lambda (v) `(,v #f)) (map car bindings)))
(initials (map (lambda (v) `(set! ,@v)) bindings)))
`(let (,@vars)
(begin ,@initials)
,@body)))
(define-macro (letrec* . args)
`(letrec ,@args))
(define-macro (when test . exprs)
(list 'if test (cons 'begin exprs) #f))
(define-macro (unless test . exprs)
(list 'if test #f (cons 'begin exprs)))
(define (equal? x y)
(cond
((eqv? x y)
@ -225,10 +244,3 @@
(eq? '*values-tag* (car res)))
(apply consumer (cdr res))
(consumer res))))
(define-macro (letrec bindings . body)
(let ((vars (map (lambda (v) `(,v #f)) (map car bindings)))
(initials (map (lambda (v) `(set! ,@v)) bindings)))
`(let (,@vars)
(begin ,@initials)
,@body)))

View File

@ -15,3 +15,37 @@
(print (my-odd? 42))
(print '(my-even? 57))
(print (my-even? 57)))
(print 70)
(print
(let ((x 2)
(y 3))
(let* ((x 7)
(z (+ x y)))
(* z x))))
(print 5)
(print
(letrec ((p
(lambda (x)
(+ 1 (q (- x 1)))))
(q
(lambda (y)
(if (zero? y)
0
(+ 1 (p (- y 1))))))
(x (p 5))
(y x))
y))
;; (let ()
;; (define my-odd? (lambda (n)
;; (if (= n 0)
;; #t
;; (not (my-even? (- n 1))))))
;; (define my-even? (lambda (n)
;; (if (= n 0)
;; #t
;; (not (my-odd? (- n 1))))))
;; (print (my-odd? 42))
;; (print (my-even? 57)))