From 0462aebce00b194ce258bc67194bf68ec30d0d01 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 14 Nov 2013 13:17:54 +0900
Subject: [PATCH] add let* and letrec*

---
 piclib/built-in.scm | 38 +++++++++++++++++++++++++-------------
 t/letrec.scm        | 34 ++++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+), 13 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 03c98548..6a27bf5b 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -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)))
diff --git a/t/letrec.scm b/t/letrec.scm
index 2848ae32..05e2e19e 100644
--- a/t/letrec.scm
+++ b/t/letrec.scm
@@ -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)))