From aa9b4e5c1436d60ef9980f7520683f6bc5ab657e Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 00:00:06 +0800
Subject: [PATCH 01/75] c3 51. test understanding of how delay works by
 printing

---
 src/c3_51.scm      | 10 ++++++++++
 src/lib/stream.scm | 11 ++++++++++-
 src/lib/utils.scm  |  3 ++-
 3 files changed, 22 insertions(+), 2 deletions(-)
 create mode 100644 src/c3_51.scm

diff --git a/src/c3_51.scm b/src/c3_51.scm
new file mode 100644
index 0000000..7d3eb4f
--- /dev/null
+++ b/src/c3_51.scm
@@ -0,0 +1,10 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define x (stream-map println (stream-enumerate-interval 0 10)))
+
+(newline)
+(stream-ref x 5)
+(newline)
+(stream-ref x 7)
diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index f630b2e..cc9d4d7 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -8,7 +8,8 @@
           stream-map
           stream-filter
           stream-enumerate-interval
-          stream-display)
+          stream-display
+          stream-ref)
 
   (import (rnrs)
           (utils))
@@ -87,4 +88,12 @@
       (begin
         (println (stream-car s))
         (stream-display (stream-cdr s)))))
+
+  (define (stream-ref s n)
+    (define (iter s-remained i)
+      (if (= i n)
+        (stream-car s-remained)
+        (iter (stream-cdr s-remained) (+ i 1))))
+    (iter s 0))
+
   )
diff --git a/src/lib/utils.scm b/src/lib/utils.scm
index 327ec34..cdba1b9 100644
--- a/src/lib/utils.scm
+++ b/src/lib/utils.scm
@@ -45,5 +45,6 @@
     (= (remainder b a) 0))
 
   (define (println v)
-    (display v)(newline))
+    (display v)(newline)
+    v)
   )

From 35ce97f3848fb53d031af0c3a0a735d02a078b91 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 00:12:58 +0800
Subject: [PATCH 02/75] c3 52.

---
 src/c3_52.scm      | 19 +++++++++++++++++++
 src/lib/stream.scm |  1 +
 2 files changed, 20 insertions(+)
 create mode 100644 src/c3_52.scm

diff --git a/src/c3_52.scm b/src/c3_52.scm
new file mode 100644
index 0000000..b264289
--- /dev/null
+++ b/src/c3_52.scm
@@ -0,0 +1,19 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(let ((sum 0))
+  (define (accum x)
+    (set! sum (+ x sum))
+    sum)
+  ; ok, assignment in lazy evaluation is really confusing
+  (let ((seq (stream-map accum (stream-enumerate-interval 1 20))))
+    (define y (stream-filter even? seq))
+    (define z (stream-filter (lambda (x) (= (remainder x 5) 0))
+                             seq))
+    (println (stream-ref y 7))
+    (newline)
+    (stream-display z)))
+
+;; the results is different. when memoize enabled, accum will be
+;; called for less times, and resulting in smaller values printed.
diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index cc9d4d7..8bb8131 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -30,6 +30,7 @@
     (syntax-rules ()
       ((cons-stream a b)
        (cons a (memo-proc (lambda () b))))))
+       ;(cons a (lambda () b)))))
 
   (define-syntax list-stream
     (syntax-rules ()

From 5878743b50d8729307a4a0f289ba4fc959e00e39 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 15:39:23 +0800
Subject: [PATCH 03/75] infinite-stream demo

---
 src/infinite-stream.scm | 33 +++++++++++++++++++++++++++++++++
 src/lib/stream.scm      | 19 +++++++++++++++++--
 src/lib/utils.scm       |  4 ++++
 src/stream.js           | 17 ++++++++++++++++-
 src/test.scm            | 40 +++++++++++++---------------------------
 5 files changed, 83 insertions(+), 30 deletions(-)
 create mode 100644 src/infinite-stream.scm

diff --git a/src/infinite-stream.scm b/src/infinite-stream.scm
new file mode 100644
index 0000000..bb259f4
--- /dev/null
+++ b/src/infinite-stream.scm
@@ -0,0 +1,33 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define (fibgen a b)
+  (cons-stream a (fibgen b (+ a b))))
+
+;(define fibs (fibgen 0 1))
+
+(define (seive s)
+  (cons-stream
+    (stream-car s)
+    (seive (stream-filter
+             (lambda (v)
+               (not (divisible? v (stream-car s))))
+             (stream-cdr s)))))
+
+(define primes (seive (integers-start-from 2)))
+
+(define ones
+  (cons-stream 1 ones))
+
+(define integers
+  (cons-stream 1 (stream-add ones integers)))
+
+; think about how to get the equation of geometric progression!!!
+(define fibs (cons-stream 0
+                          (cons-stream 1
+                                       (stream-add (stream-cdr fibs)
+                                                   fibs))))
+
+
+(define double (cons-stream 1 (stream-scale double 2)))
diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index 8bb8131..2051076 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -9,7 +9,11 @@
           stream-filter
           stream-enumerate-interval
           stream-display
-          stream-ref)
+          stream-ref
+          stream-add
+          stream-scale
+          integers-start-from
+          stream-mult)
 
   (import (rnrs)
           (utils))
@@ -30,7 +34,7 @@
     (syntax-rules ()
       ((cons-stream a b)
        (cons a (memo-proc (lambda () b))))))
-       ;(cons a (lambda () b)))))
+  ;(cons a (lambda () b)))))
 
   (define-syntax list-stream
     (syntax-rules ()
@@ -97,4 +101,15 @@
         (iter (stream-cdr s-remained) (+ i 1))))
     (iter s 0))
 
+  (define (stream-add s1 s2)
+    (stream-map + s1 s2))
+
+  (define (stream-scale s factor)
+    (stream-map (lambda (x) (* x factor)) s))
+
+  (define (integers-start-from n)
+    (cons-stream n (integers-start-from (+ n 1))))
+
+  (define (stream-mult s1 s2)
+    (stream-map * s1 s2))
   )
diff --git a/src/lib/utils.scm b/src/lib/utils.scm
index cdba1b9..ca58030 100644
--- a/src/lib/utils.scm
+++ b/src/lib/utils.scm
@@ -9,6 +9,7 @@
           random-in-range
           sleepfor
           divides?
+          divisible? 
           println)
   (import (chezscheme))
   (define (set-cadr! lst v)
@@ -44,6 +45,9 @@
   (define (divides? a b)
     (= (remainder b a) 0))
 
+  (define (divisible? x y)
+    (= (remainder x y) 0))
+
   (define (println v)
     (display v)(newline)
     v)
diff --git a/src/stream.js b/src/stream.js
index 8f633e0..ebf1b13 100644
--- a/src/stream.js
+++ b/src/stream.js
@@ -24,6 +24,9 @@ var cdr = exports.cdr = function (s) {
     return s.cdr().apply();
 };
 
+var ref = exports.ref = function (s, n) {
+};
+
 var range = exports.range = function (low, high) {
     if (low > high) {
         return empty;
@@ -34,4 +37,16 @@ var range = exports.range = function (low, high) {
     }
 };
 
-console.log(car(cdr(range(2, 4))));
+function integersStartFrom(n) {
+    return cons(n, function () {
+        return integersStartFrom(n + 1);
+    });
+};
+
+function fibgen (a, b) {
+    return cons(a, function () {
+        return fibgen(b, a + b);
+    });
+};
+
+var fibs = fibgen(0, 1);
diff --git a/src/test.scm b/src/test.scm
index f80fa61..8c6032a 100644
--- a/src/test.scm
+++ b/src/test.scm
@@ -1,27 +1,13 @@
-(define (make-semaphore n)
-  (let ((cell (list #f)))
-    (define (acquire)
-      (if (test-and-set! cell)
-        (acquire)
-        (begin
-          (cond ((> n 0)
-                 (set! n (- n 1))
-                 (clear! cell)
-                 #t)
-                (else
-                  (clear! cell)
-                  (acquire))))))
-    (define (release)
-      (if (test-and-set! cell)
-        (begin
-          (clear! cell)
-          (release))
-        (begin
-          (set! n (+ n 1))
-          (clear! cell))))
-    (define (self msg)
-      (cond ((eq? msg 'acquire) acquire)
-            ((eq? msg 'release) release)
-            (else
-              (error 'semaphore-self "UNKNOWN MESSAGE" msg))))
-    self))
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define primes (cons-stream 2
+                            (stream-filter prime? (integers-start-from 3))))
+
+(define (prime? n)
+  (define (iter ps)
+    (cond ((> (square (stream-car ps)) n) #t)
+          ((divisible? n (stream-car ps)) #f)
+
+(println (stream-ref primes 50))

From 0fe3b626d6342b4a4ab6b94de497667993d4e525 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 15:39:33 +0800
Subject: [PATCH 04/75] c3 53; 54

---
 src/c3_53.scm | 9 +++++++++
 src/c3_54.scm | 8 ++++++++
 2 files changed, 17 insertions(+)
 create mode 100644 src/c3_53.scm
 create mode 100644 src/c3_54.scm

diff --git a/src/c3_53.scm b/src/c3_53.scm
new file mode 100644
index 0000000..ac518fc
--- /dev/null
+++ b/src/c3_53.scm
@@ -0,0 +1,9 @@
+; X0 = 1, Xn+1 = 2Xn
+
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define s (cons-stream 1 (stream-add s s)))
+
+(println (stream-ref s 10)) ; 1024
diff --git a/src/c3_54.scm b/src/c3_54.scm
new file mode 100644
index 0000000..a89c2de
--- /dev/null
+++ b/src/c3_54.scm
@@ -0,0 +1,8 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define factorials (cons-stream 1
+                       (stream-mult (integers-start-from 2) s)))
+
+(println (stream-ref factorials 3))

From 05f6006e90afedbf4e7486dc583f05baa98adaed Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 16:26:56 +0800
Subject: [PATCH 05/75] c3 55;56

---
 src/c3_55.scm      |  5 +++++
 src/c3_56.scm      | 31 +++++++++++++++++++++++++++++++
 src/lib/stream.scm | 27 ++++++++++++++++++++++++++-
 3 files changed, 62 insertions(+), 1 deletion(-)
 create mode 100644 src/c3_55.scm
 create mode 100644 src/c3_56.scm

diff --git a/src/c3_55.scm b/src/c3_55.scm
new file mode 100644
index 0000000..9477455
--- /dev/null
+++ b/src/c3_55.scm
@@ -0,0 +1,5 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(stream-display-n (partial-sum integers) 10)
diff --git a/src/c3_56.scm b/src/c3_56.scm
new file mode 100644
index 0000000..7554487
--- /dev/null
+++ b/src/c3_56.scm
@@ -0,0 +1,31 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define (merge s1 s2)
+  (cond ((stream-null? s1) s2)
+        ((stream-null? s2) s1)
+        (else
+          (let ((s1car (stream-car s1))
+                (s2car (stream-car s2)))
+            (cond ((< s1car s2car)
+                   (cons-stream s1car
+                                (merge (stream-cdr s1)
+                                       s2)))
+                  ((> s1car s2car)
+                   (cons-stream s2car
+                                (merge s1
+                                       (stream-cdr s2))))
+                  (else
+                    (cons-stream s1car
+                                 (merge (stream-cdr s1)
+                                        (stream-cdr s2)))))))))
+
+;(stream-display (merge (list-stream 1 2 3)
+                       ;(list-stream 2 3 4)))
+
+(define S (cons-stream 1 (merge (stream-scale S 2)
+                                (merge (stream-scale S 3)
+                                       (stream-scale S 5)))))
+
+(stream-display-n S 10)
diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index 2051076..313950f 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -4,6 +4,7 @@
           list-stream
           stream-car
           stream-cdr
+          stream-null?
           the-empty-stream
           stream-map
           stream-filter
@@ -13,7 +14,10 @@
           stream-add
           stream-scale
           integers-start-from
-          stream-mult)
+          stream-mult
+          partial-sum
+          integers
+          stream-display-n)
 
   (import (rnrs)
           (utils))
@@ -94,6 +98,14 @@
         (println (stream-car s))
         (stream-display (stream-cdr s)))))
 
+  (define (stream-display-n s n)
+    (define (iter s i)
+      (if (< i n)
+        (begin
+          (println (stream-car s))
+          (iter (stream-cdr s) (+ i 1)))))
+    (iter s 0))
+
   (define (stream-ref s n)
     (define (iter s-remained i)
       (if (= i n)
@@ -112,4 +124,17 @@
 
   (define (stream-mult s1 s2)
     (stream-map * s1 s2))
+
+  (define ones
+    (cons-stream 1 ones))
+
+
+  (define integers
+    (cons-stream 1 (stream-add ones integers)))
+
+  (define (partial-sum s)
+    (define sum (cons-stream (stream-car s)
+                             (stream-add (stream-cdr s)
+                                         sum)))
+    sum)
   )

From 2578f2938d0b95e1ad2d7748c7aef4cb1fc0f122 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 22:15:03 +0800
Subject: [PATCH 06/75] c3 57

---
 src/c3_57.scm | 15 +++++++++++++++
 1 file changed, 15 insertions(+)
 create mode 100644 src/c3_57.scm

diff --git a/src/c3_57.scm b/src/c3_57.scm
new file mode 100644
index 0000000..0cc260d
--- /dev/null
+++ b/src/c3_57.scm
@@ -0,0 +1,15 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+
+(define fibs (cons-stream 0
+                          (cons-stream 1
+                                       (stream-add (stream-cdr fibs)
+                                                   fibs))))
+
+(stream-ref fibs 7)
+
+; n additions are performed when optimization provided.
+; Think about dynamic programming. (stream-ref fibs n) = (stream-ref fibs n-1) + (stream-ref fibs n-2)
+; when no memoize enabled, for each (stream-ref fibs n-1), it will be recalculated.

From b47eaa1fae01428c037b5da2caa3843fdea37742 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 22:21:44 +0800
Subject: [PATCH 07/75] c3 58; really dull question

---
 src/c3_58.scm | 12 ++++++++++++
 1 file changed, 12 insertions(+)
 create mode 100644 src/c3_58.scm

diff --git a/src/c3_58.scm b/src/c3_58.scm
new file mode 100644
index 0000000..19a069a
--- /dev/null
+++ b/src/c3_58.scm
@@ -0,0 +1,12 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define (expand num den radix)
+  (cons-stream
+    (quotient (* num radix) den)
+    (expand (remainder (* num radix) den) den radix)))
+
+(stream-display-n (expand 1 7 10) 10)
+(newline)
+(stream-display-n (expand 3 8 10) 5)

From 972cbe849fdd5576c0db22b4bc565c6956ba68ad Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 23:49:32 +0800
Subject: [PATCH 08/75] c3 59

---
 src/c3_59.scm | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)
 create mode 100644 src/c3_59.scm

diff --git a/src/c3_59.scm b/src/c3_59.scm
new file mode 100644
index 0000000..606bb50
--- /dev/null
+++ b/src/c3_59.scm
@@ -0,0 +1,21 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define (integrate-series s)
+  (stream-div s
+              (integers-start-from 1)))
+
+; (stream-display (integrate-series (list-stream 1 2 1)))
+
+(define exp-series
+  (cons-stream 1 (integrate-series exp-series)))
+
+
+(define sine-series
+  (cons-stream 0 (integrate-series cosine-series)))
+(define cosine-series
+  (cons-stream 1 (integrate-series (negate sine-series))))
+
+;(stream-display-n sine-series 10)(newline)
+;(stream-display-n cosine-series 10)

From c6869f17098703dbbb88156d96c75c4b1d56ed2c Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 23:49:47 +0800
Subject: [PATCH 09/75] c3 60;mul-series

---
 src/c3_60.scm | 12 ++++++++++++
 1 file changed, 12 insertions(+)
 create mode 100644 src/c3_60.scm

diff --git a/src/c3_60.scm b/src/c3_60.scm
new file mode 100644
index 0000000..317a5e6
--- /dev/null
+++ b/src/c3_60.scm
@@ -0,0 +1,12 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+
+(define (mul-series s1 s2)
+  (cons-stream (* (stream-car s1) (stream-car s2))
+               (add-streams (mul-series (stream-cdr s1) s2)
+                            (scale-stream (stream-cdr s2) (stream-car s1)))))
+
+; How did we get the result?
+; see https://www.dropbox.com/s/qxnzmwe17kmd09z/2013-09-20%2023.45.44.jpg

From c2832321d5d346799804a2ceb25293069d869916 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 20 Sep 2013 23:50:01 +0800
Subject: [PATCH 10/75] update stream

---
 src/lib/stream.scm | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index 313950f..637889d 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -15,9 +15,11 @@
           stream-scale
           integers-start-from
           stream-mult
+          stream-div
           partial-sum
           integers
-          stream-display-n)
+          stream-display-n
+          negate)
 
   (import (rnrs)
           (utils))
@@ -38,7 +40,7 @@
     (syntax-rules ()
       ((cons-stream a b)
        (cons a (memo-proc (lambda () b))))))
-  ;(cons a (lambda () b)))))
+       ;(cons a (lambda () b)))))
 
   (define-syntax list-stream
     (syntax-rules ()
@@ -95,14 +97,14 @@
   (define (stream-display s)
     (if (not (stream-null? s))
       (begin
-        (println (stream-car s))
+        (display (stream-car s))(display " ")
         (stream-display (stream-cdr s)))))
 
   (define (stream-display-n s n)
     (define (iter s i)
       (if (< i n)
         (begin
-          (println (stream-car s))
+          (display (stream-car s))(display " ")
           (iter (stream-cdr s) (+ i 1)))))
     (iter s 0))
 
@@ -125,9 +127,14 @@
   (define (stream-mult s1 s2)
     (stream-map * s1 s2))
 
+  (define (stream-div s1 s2)
+    (stream-map / s1 s2))
+
   (define ones
     (cons-stream 1 ones))
 
+  (define negative-ones
+    (cons-stream -1 negative-ones))
 
   (define integers
     (cons-stream 1 (stream-add ones integers)))
@@ -137,4 +144,8 @@
                              (stream-add (stream-cdr s)
                                          sum)))
     sum)
+
+  (define (negate s)
+    (stream-mult negative-ones
+                 s))
   )

From 19cc7d64083bae334d8dd4a235e24715cab1253d Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 10:58:21 +0800
Subject: [PATCH 11/75] lib series

---
 src/lib/series.scm | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)
 create mode 100644 src/lib/series.scm

diff --git a/src/lib/series.scm b/src/lib/series.scm
new file mode 100644
index 0000000..921a5fd
--- /dev/null
+++ b/src/lib/series.scm
@@ -0,0 +1,29 @@
+(library
+  (series)
+  (export mul-series
+          add-series
+          integrate-series
+          exp-series
+          sine-series
+          cosine-series)
+
+  (import (rnrs)
+          (stream)
+          (utils))
+
+  (define (integrate-series s)
+    (stream-div s
+                (integers-start-from 1)))
+  (define sine-series
+    (cons-stream 0 (integrate-series cosine-series)))
+  (define cosine-series
+    (cons-stream 1 (integrate-series (negate sine-series))))
+  (define exp-series
+    (cons-stream 1 (integrate-series exp-series)))
+  (define (mul-series s1 s2)
+    (cons-stream (* (stream-car s1) (stream-car s2))
+                 (stream-add (mul-series (stream-cdr s1) s2)
+                             (stream-scale (stream-cdr s2) (stream-car s1)))))
+  (define add-series stream-add)
+  )
+

From 9338e91c32acff7cbce3d581be7c2de884721d89 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 10:58:28 +0800
Subject: [PATCH 12/75] update c3 59;60

---
 src/c3_59.scm | 17 ++---------------
 src/c3_60.scm | 12 +++++-------
 2 files changed, 7 insertions(+), 22 deletions(-)

diff --git a/src/c3_59.scm b/src/c3_59.scm
index 606bb50..d368a1b 100644
--- a/src/c3_59.scm
+++ b/src/c3_59.scm
@@ -2,20 +2,7 @@
         (stream)
         (utils))
 
-(define (integrate-series s)
-  (stream-div s
-              (integers-start-from 1)))
-
 ; (stream-display (integrate-series (list-stream 1 2 1)))
 
-(define exp-series
-  (cons-stream 1 (integrate-series exp-series)))
-
-
-(define sine-series
-  (cons-stream 0 (integrate-series cosine-series)))
-(define cosine-series
-  (cons-stream 1 (integrate-series (negate sine-series))))
-
-;(stream-display-n sine-series 10)(newline)
-;(stream-display-n cosine-series 10)
+(stream-display-n sine-series 10)(newline)
+(stream-display-n cosine-series 10)
diff --git a/src/c3_60.scm b/src/c3_60.scm
index 317a5e6..90d04c4 100644
--- a/src/c3_60.scm
+++ b/src/c3_60.scm
@@ -1,12 +1,10 @@
 (import (rnrs)
         (stream)
-        (utils))
-
-
-(define (mul-series s1 s2)
-  (cons-stream (* (stream-car s1) (stream-car s2))
-               (add-streams (mul-series (stream-cdr s1) s2)
-                            (scale-stream (stream-cdr s2) (stream-car s1)))))
+        (utils)
+        (series))
 
+(stream-display-n (stream-add (mul-series sine-series sine-series)
+                               (mul-series cosine-series cosine-series))
+                  10)
 ; How did we get the result?
 ; see https://www.dropbox.com/s/qxnzmwe17kmd09z/2013-09-20%2023.45.44.jpg

From 81daaf82b5f0169efa80ab9b9e1f229a1b80ca86 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 11:31:53 +0800
Subject: [PATCH 13/75] c3 61

---
 src/c3_61.scm      |  5 +++++
 src/lib/series.scm | 14 +++++++++++---
 src/lib/stream.scm | 14 ++++++++++++--
 3 files changed, 28 insertions(+), 5 deletions(-)
 create mode 100644 src/c3_61.scm

diff --git a/src/c3_61.scm b/src/c3_61.scm
new file mode 100644
index 0000000..0014fe8
--- /dev/null
+++ b/src/c3_61.scm
@@ -0,0 +1,5 @@
+(import (rnrs)
+        (stream)
+        (series))
+
+(stream-display-n (invert-unit-series exp-series) 10)
diff --git a/src/lib/series.scm b/src/lib/series.scm
index 921a5fd..93b9e1e 100644
--- a/src/lib/series.scm
+++ b/src/lib/series.scm
@@ -5,7 +5,8 @@
           integrate-series
           exp-series
           sine-series
-          cosine-series)
+          cosine-series
+          invert-unit-series)
 
   (import (rnrs)
           (stream)
@@ -17,7 +18,7 @@
   (define sine-series
     (cons-stream 0 (integrate-series cosine-series)))
   (define cosine-series
-    (cons-stream 1 (integrate-series (negate sine-series))))
+    (cons-stream 1 (integrate-series (stream-negate sine-series))))
   (define exp-series
     (cons-stream 1 (integrate-series exp-series)))
   (define (mul-series s1 s2)
@@ -25,5 +26,12 @@
                  (stream-add (mul-series (stream-cdr s1) s2)
                              (stream-scale (stream-cdr s2) (stream-car s1)))))
   (define add-series stream-add)
+  (define minus-series stream-minus)
+  (define (invert-unit-series s)
+    (define inverted-series
+      (cons-stream 1
+                   (stream-negate
+                     (mul-series (stream-cdr s)
+                                 inverted-series))))
+    inverted-series)
   )
-
diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index 637889d..0dd1a6a 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -12,6 +12,7 @@
           stream-display
           stream-ref
           stream-add
+          stream-minus
           stream-scale
           integers-start-from
           stream-mult
@@ -19,7 +20,8 @@
           partial-sum
           integers
           stream-display-n
-          negate)
+          stream-negate
+          one-zeros)
 
   (import (rnrs)
           (utils))
@@ -118,6 +120,9 @@
   (define (stream-add s1 s2)
     (stream-map + s1 s2))
 
+  (define (stream-minus s1 s2)
+    (stream-map - s1 s2))
+
   (define (stream-scale s factor)
     (stream-map (lambda (x) (* x factor)) s))
 
@@ -130,9 +135,14 @@
   (define (stream-div s1 s2)
     (stream-map / s1 s2))
 
+  (define zeros
+    (cons-stream 0 zeros))
+
   (define ones
     (cons-stream 1 ones))
 
+  (define one-zeros (cons-stream 1 zeros))
+
   (define negative-ones
     (cons-stream -1 negative-ones))
 
@@ -145,7 +155,7 @@
                                          sum)))
     sum)
 
-  (define (negate s)
+  (define (stream-negate s)
     (stream-mult negative-ones
                  s))
   )

From d732d61b1a1a5d60947675bbcbaba76d16a261d4 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 11:45:56 +0800
Subject: [PATCH 14/75] c3 62

---
 src/c3_62.scm      |  5 +++++
 src/lib/series.scm | 14 +++++++++++++-
 2 files changed, 18 insertions(+), 1 deletion(-)
 create mode 100644 src/c3_62.scm

diff --git a/src/c3_62.scm b/src/c3_62.scm
new file mode 100644
index 0000000..f6b922c
--- /dev/null
+++ b/src/c3_62.scm
@@ -0,0 +1,5 @@
+(import (rnrs)
+        (stream)
+        (series))
+
+(stream-display-n tan-series 10)
diff --git a/src/lib/series.scm b/src/lib/series.scm
index 93b9e1e..863ae40 100644
--- a/src/lib/series.scm
+++ b/src/lib/series.scm
@@ -6,7 +6,9 @@
           exp-series
           sine-series
           cosine-series
-          invert-unit-series)
+          invert-unit-series
+          div-series
+          tan-series)
 
   (import (rnrs)
           (stream)
@@ -34,4 +36,14 @@
                      (mul-series (stream-cdr s)
                                  inverted-series))))
     inverted-series)
+
+  (define (div-series s1 s2)
+    (let ((c2 (stream-car s2)))
+      (if (= c2 0)
+        (error div-series "series haszero constant term")
+        (mul-series (stream-scale s1 (/ 1 c2))
+                    (invert-unit-series (stream-scale s2 (/ 1 c2)))))))
+
+  (define tan-series
+    (div-series sine-series cosine-series))
   )

From 7505a20c08e439d6f17cc946c556405e2703f2bb Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 17:39:59 +0800
Subject: [PATCH 15/75] euler transform

---
 src/euler-transform.scm | 46 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)
 create mode 100644 src/euler-transform.scm

diff --git a/src/euler-transform.scm b/src/euler-transform.scm
new file mode 100644
index 0000000..1a6de9e
--- /dev/null
+++ b/src/euler-transform.scm
@@ -0,0 +1,46 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define (sqrt-improve guess x)
+  (average guess (/ x guess)))
+
+(define (sqrt-stream x)
+  (define guesses
+    (cons-stream 1.0
+                 (stream-map (lambda (guess)
+                               (sqrt-improve guess x))
+                             guesses)))
+  guesses)
+
+(define (pi-summands n)
+  (cons-stream (/ 1.0 n)
+               (stream-map - (pi-summands (+ n 2)))))
+
+(define pi-stream
+  (stream-scale (partial-sum (pi-summands 1)) 4))
+
+(define (euler-transform s)
+  (let ((s0 (stream-ref s 0))
+        (s1 (stream-ref s 1))
+        (s2 (stream-ref s 2)))
+    (cons-stream (- s2 (/ (square (- s2 s1))
+                          (+ s0 (* -2 s1) s2)))
+                 (euler-transform (stream-cdr s)))))
+
+; (stream-display-n (euler-transform pi-stream) 10)
+
+(define (make-tableau transform s)
+  (cons-stream s
+               (make-tableau transform
+                             (transform s))))
+(define (make-tableau transform s)
+  (cons-stream s
+               (make-tableau transform
+                             (transform s))))
+
+(define (accelerated-sequence transform s)
+  (stream-map stream-car
+              (make-tableau transform s)))
+
+(stream-display-n (accelerated-sequence euler-transform pi-stream) 10)

From 7f90aa85010a405b7f7feca470d6baf43919626a Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 17:40:17 +0800
Subject: [PATCH 16/75] update

---
 src/lib/stream.scm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index 0dd1a6a..10a80a9 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -149,6 +149,7 @@
   (define integers
     (cons-stream 1 (stream-add ones integers)))
 
+  ; sum of stream
   (define (partial-sum s)
     (define sum (cons-stream (stream-car s)
                              (stream-add (stream-cdr s)

From d7c9d880aa516958ab12062c6b8d95c50043b7f1 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 19:53:37 +0800
Subject: [PATCH 17/75] c3 63; not really understand

---
 src/c3_63_notreally_understand.scm | 38 ++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)
 create mode 100644 src/c3_63_notreally_understand.scm

diff --git a/src/c3_63_notreally_understand.scm b/src/c3_63_notreally_understand.scm
new file mode 100644
index 0000000..fc8685b
--- /dev/null
+++ b/src/c3_63_notreally_understand.scm
@@ -0,0 +1,38 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+
+;(stream-display-n (partial-sum1 integers) 3)
+(println (stream-ref (partial-sum integers) 3))
+
+
+(partial-sum integers) ->
+(cons-stream (stream-car s)
+             (cons-stream (+ (stream-car (stream-cdr s))
+                             (stream-car sum))
+                          (cons-stream (+ (stream-car (stream-cdr (stream-cdr s)))
+                                          (stream-car (stream-cdr sum))))))
+                          ...
+
+(define (partial-sum s)
+  (cons-stream (stream-car s)
+               (stream-add (stream-cdr s)
+                           (partial-sum s))))
+(partial-sum integers) ->
+
+(cons-stream (stream-car s)
+             (stream-add (stream-cdr s)
+                         (cons-stream (stream-car s)
+                                      (stream-add (stream-cdr s)
+                                                  (partial-sum s))))) ->
+(cons-stream (stream-car s)
+             (cons-stream (+ (stream-car (stream-cdr s))
+                             (stream-car (cons-stream (stream-car s)
+                                                      (stream-add (stream-cdr s)
+                                                                  (partial-sum s)))))
+                          (stream-map +
+                                      (stream-cdr (stream-cdr s))
+                                      (stream-cdr (cons-stream (stream-car s)
+                                                               (stream-add (stream-cdr s)
+                                                                           (partial-sum s)))))))

From 056a91169d707b63684eb3636df80d11136b4244 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 20:04:07 +0800
Subject: [PATCH 18/75] c3 64

---
 src/c3_64.scm     | 28 ++++++++++++++++++++++++++++
 src/lib/utils.scm |  6 +++++-
 2 files changed, 33 insertions(+), 1 deletion(-)
 create mode 100644 src/c3_64.scm

diff --git a/src/c3_64.scm b/src/c3_64.scm
new file mode 100644
index 0000000..9196af5
--- /dev/null
+++ b/src/c3_64.scm
@@ -0,0 +1,28 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define (sqrt-improve guess x)
+  (average guess (/ x guess)))
+
+(define (sqrt-stream x)
+  (define guesses
+    (cons-stream 1.0
+                 (stream-map (lambda (guess)
+                               (sqrt-improve guess x))
+                             guesses)))
+  guesses)
+
+
+(define (stream-limit s tolerance)
+  (let ((v1 (stream-car s))
+        (v2 (stream-car (stream-cdr s))))
+    (if (< (abs (- v1 v2))
+           tolerance)
+      v1
+      (stream-limit (stream-cdr s) tolerance))))
+
+(define (mysqrt x tolerance)
+  (stream-limit (sqrt-stream x) tolerance))
+
+(println (mysqrt 4 0.001))
diff --git a/src/lib/utils.scm b/src/lib/utils.scm
index ca58030..ac71459 100644
--- a/src/lib/utils.scm
+++ b/src/lib/utils.scm
@@ -10,7 +10,8 @@
           sleepfor
           divides?
           divisible? 
-          println)
+          println
+          average)
   (import (chezscheme))
   (define (set-cadr! lst v)
     (set-car! (cdr lst) v))
@@ -51,4 +52,7 @@
   (define (println v)
     (display v)(newline)
     v)
+
+  (define (average a b)
+    (/ (+ a b) 2.0))
   )

From 0aff86e18ffc00cfc734e1065b9497115c97b47c Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 20:24:59 +0800
Subject: [PATCH 19/75] c3 65

---
 src/c3_65.scm           | 21 +++++++++++++++++++++
 src/euler-transform.scm |  4 ----
 src/lib/series.scm      | 28 +++++++++++++++++++++++++++-
 3 files changed, 48 insertions(+), 5 deletions(-)
 create mode 100644 src/c3_65.scm

diff --git a/src/c3_65.scm b/src/c3_65.scm
new file mode 100644
index 0000000..be8fc49
--- /dev/null
+++ b/src/c3_65.scm
@@ -0,0 +1,21 @@
+(import (rnrs)
+        (series)
+        (stream)
+        (utils))
+
+(define (log2-summands n)
+  (cons-stream (/ 1.0 n)
+               (stream-negate (log2-summands (+ n 1)))))
+
+(define log2-series (log2-summands 1))
+
+(println (log 2))
+
+(define log2 (partial-sum log2-series))
+(stream-display-n log2 10)(newline)
+
+(stream-display-n (euler-transform log2) 10)(newline)
+
+(stream-display-n (accelerated-sequence euler-transform
+                                        log2)
+                  10)
diff --git a/src/euler-transform.scm b/src/euler-transform.scm
index 1a6de9e..c0d8017 100644
--- a/src/euler-transform.scm
+++ b/src/euler-transform.scm
@@ -30,10 +30,6 @@
 
 ; (stream-display-n (euler-transform pi-stream) 10)
 
-(define (make-tableau transform s)
-  (cons-stream s
-               (make-tableau transform
-                             (transform s))))
 (define (make-tableau transform s)
   (cons-stream s
                (make-tableau transform
diff --git a/src/lib/series.scm b/src/lib/series.scm
index 863ae40..ca1cfdd 100644
--- a/src/lib/series.scm
+++ b/src/lib/series.scm
@@ -8,7 +8,11 @@
           cosine-series
           invert-unit-series
           div-series
-          tan-series)
+          tan-series
+          pi-series
+          euler-transform
+          accelerated-sequence)
+
 
   (import (rnrs)
           (stream)
@@ -46,4 +50,26 @@
 
   (define tan-series
     (div-series sine-series cosine-series))
+
+  (define (euler-transform s)
+    (let ((s0 (stream-ref s 0))
+          (s1 (stream-ref s 1))
+          (s2 (stream-ref s 2)))
+      (cons-stream (- s2 (/ (square (- s2 s1))
+                            (+ s0 (* -2 s1) s2)))
+                   (euler-transform (stream-cdr s)))))
+
+  (define (make-tableau transform s)
+    (cons-stream s
+                 (make-tableau transform
+                               (transform s))))
+  (define (accelerated-sequence transform s)
+    (stream-map stream-car
+                (make-tableau transform s)))
+
+  (define (pi-summands n)
+    (cons-stream (/ 1.0 n)
+                 (stream-map - (pi-summands (+ n 2)))))
+  (define pi-series (pi-summands 1))
+
   )

From 316b13a15c01e3ae5185c922fb09709aa45253cb Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 20:43:21 +0800
Subject: [PATCH 20/75] stream of pairs

---
 src/stream-of-pairs.scm | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)
 create mode 100644 src/stream-of-pairs.scm

diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
new file mode 100644
index 0000000..0f1073b
--- /dev/null
+++ b/src/stream-of-pairs.scm
@@ -0,0 +1,30 @@
+(import (rnrs)
+        (stream)
+        (utils)
+        (prime))
+
+
+(define (pairs s t)
+  (let ((s0 (stream-car s))
+        (t0 (stream-car t)))
+    (cons-stream (list s0 t0)
+                 (interleave (stream-map (lambda (ti)
+                                           (list s0 ti))
+                                         (stream-cdr t))
+                             (pairs (stream-cdr s)
+                                    (stream-cdr t))))))
+
+(define int-pairs (pairs integers integers))
+
+(define (interleave s1 s2)
+  (if (stream-null? s1)
+    s2
+    (cons-stream (stream-car s1)
+                 (interleave s2
+                             (stream-cdr s1)))))
+
+(stream-display-n (stream-filter (lambda (pair)
+                                   (prime? (+ (car pair)
+                                              (cadr pair))))
+                                 int-pairs)
+                  10)

From 70bcf737586d9e611e0d11514e11866797f2632f Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 21:00:49 +0800
Subject: [PATCH 21/75] c3 66;67

---
 src/c3_66.scm           |  1 +
 src/c3_67.scm           |  1 +
 src/stream-of-pairs.scm | 25 ++++++++++++++++++++-----
 3 files changed, 22 insertions(+), 5 deletions(-)
 create mode 100644 src/c3_66.scm
 create mode 100644 src/c3_67.scm

diff --git a/src/c3_66.scm b/src/c3_66.scm
new file mode 100644
index 0000000..834dfa6
--- /dev/null
+++ b/src/c3_66.scm
@@ -0,0 +1 @@
+; wtf
diff --git a/src/c3_67.scm b/src/c3_67.scm
new file mode 100644
index 0000000..533c92e
--- /dev/null
+++ b/src/c3_67.scm
@@ -0,0 +1 @@
+; in stream-of-pairs.scm
diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
index 0f1073b..cd1878a 100644
--- a/src/stream-of-pairs.scm
+++ b/src/stream-of-pairs.scm
@@ -23,8 +23,23 @@
                  (interleave s2
                              (stream-cdr s1)))))
 
-(stream-display-n (stream-filter (lambda (pair)
-                                   (prime? (+ (car pair)
-                                              (cadr pair))))
-                                 int-pairs)
-                  10)
+(stream-ref (stream-filter (lambda (pair)
+                             (prime? (+ (car pair)
+                                        (cadr pair))))
+                           int-pairs) 10)
+
+; 3.67
+(define (full-pairs s t)
+  (let ((s0 (stream-car s))
+        (t0 (stream-car t)))
+    (cons-stream (list s0 t0)
+                 (interleave (interleave (stream-map (lambda (ti)
+                                                       (list s0 ti))
+                                                     (stream-cdr t))
+                                         (stream-map (lambda (si)
+                                                       (list si t0))
+                                                     (stream-cdr s)))
+                             (full-pairs (stream-cdr s)
+                                         (stream-cdr t))))))
+
+(stream-display-n (full-pairs integers integers) 20)

From b21f85d97911dd36462bc73b8a422d36227c321e Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 21:12:49 +0800
Subject: [PATCH 22/75] c3 68

---
 src/c3_68.scm           |  3 +++
 src/stream-of-pairs.scm | 11 ++++++++++-
 2 files changed, 13 insertions(+), 1 deletion(-)
 create mode 100644 src/c3_68.scm

diff --git a/src/c3_68.scm b/src/c3_68.scm
new file mode 100644
index 0000000..5625a12
--- /dev/null
+++ b/src/c3_68.scm
@@ -0,0 +1,3 @@
+; code is in stream-of-pairs.scm
+; infinite recursion occured for the code, since second args of interleave
+; is not delayed.
diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
index cd1878a..257ea96 100644
--- a/src/stream-of-pairs.scm
+++ b/src/stream-of-pairs.scm
@@ -42,4 +42,13 @@
                              (full-pairs (stream-cdr s)
                                          (stream-cdr t))))))
 
-(stream-display-n (full-pairs integers integers) 20)
+(stream-ref (full-pairs integers integers) 20)
+
+; 3.68
+(define (louis-pairs s t)
+  (interleave
+    (stream-map (lambda (x) (list (stream-car s) x))
+                t)
+    (louis-pairs (stream-cdr s) (stream-cdr t))))
+
+; (stream-display-n (louis-pairs integers integers) 10)

From b878f5a3fe986a54884051d2a1e68cdac30fafc9 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 21:42:22 +0800
Subject: [PATCH 23/75] c3 69; triples

---
 src/c3_69.scm           |  1 +
 src/lib/stream.scm      | 25 +++++++++++++++++--------
 src/stream-of-pairs.scm | 16 ++++++++++++++++
 3 files changed, 34 insertions(+), 8 deletions(-)
 create mode 100644 src/c3_69.scm

diff --git a/src/c3_69.scm b/src/c3_69.scm
new file mode 100644
index 0000000..533c92e
--- /dev/null
+++ b/src/c3_69.scm
@@ -0,0 +1 @@
+; in stream-of-pairs.scm
diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index 10a80a9..4f1e20d 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -21,7 +21,8 @@
           integers
           stream-display-n
           stream-negate
-          one-zeros)
+          one-zeros
+          interleave)
 
   (import (rnrs)
           (utils))
@@ -40,16 +41,16 @@
 
   (define-syntax cons-stream
     (syntax-rules ()
-      ((cons-stream a b)
-       (cons a (memo-proc (lambda () b))))))
-       ;(cons a (lambda () b)))))
+                  ((cons-stream a b)
+                   (cons a (memo-proc (lambda () b))))))
+  ;(cons a (lambda () b)))))
 
   (define-syntax list-stream
     (syntax-rules ()
-      [(_) the-empty-stream]
-      [(_ a b ...)
-       (cons-stream a
-                    (list-stream b ...))]))
+                  [(_) the-empty-stream]
+                  [(_ a b ...)
+                   (cons-stream a
+                                (list-stream b ...))]))
 
   (define (stream-car stream) (car stream))
 
@@ -159,4 +160,12 @@
   (define (stream-negate s)
     (stream-mult negative-ones
                  s))
+
+  ; interleave two streams
+  (define (interleave s1 s2)
+    (if (stream-null? s1)
+      s2
+      (cons-stream (stream-car s1)
+                   (interleave s2
+                               (stream-cdr s1)))))
   )
diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
index 257ea96..0fe6f6d 100644
--- a/src/stream-of-pairs.scm
+++ b/src/stream-of-pairs.scm
@@ -52,3 +52,19 @@
     (louis-pairs (stream-cdr s) (stream-cdr t))))
 
 ; (stream-display-n (louis-pairs integers integers) 10)
+
+; 3.69
+(define (triples s t u)
+  (cons-stream (list (stream-car s)
+                     (stream-car t)
+                     (stream-car u))
+               (interleave (stream-map (lambda (pair)
+                                         (cons (stream-car s) pair))
+                                       (stream-cdr (pairs t u)))
+                           (triples (stream-cdr s)
+                                    (stream-cdr t)
+                                    (stream-cdr u)))))
+
+(define int-triples (triples integers integers integers))
+
+(stream-ref int-triples 100)

From 33e010b915ac6097a64209826ca18ba439061a71 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 21:47:32 +0800
Subject: [PATCH 24/75] c3 69 update

---
 src/lib/utils.scm       | 8 +++++++-
 src/stream-of-pairs.scm | 9 ++++++++-
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/src/lib/utils.scm b/src/lib/utils.scm
index ac71459..bbc4797 100644
--- a/src/lib/utils.scm
+++ b/src/lib/utils.scm
@@ -11,7 +11,8 @@
           divides?
           divisible? 
           println
-          average)
+          average
+          pythagorean-triple?)
   (import (chezscheme))
   (define (set-cadr! lst v)
     (set-car! (cdr lst) v))
@@ -55,4 +56,9 @@
 
   (define (average a b)
     (/ (+ a b) 2.0))
+
+  (define (pythagorean-triple? i j k)
+    (= (square k)
+       (+ (square i)
+          (square j))))
   )
diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
index 0fe6f6d..4ee8d31 100644
--- a/src/stream-of-pairs.scm
+++ b/src/stream-of-pairs.scm
@@ -67,4 +67,11 @@
 
 (define int-triples (triples integers integers integers))
 
-(stream-ref int-triples 100)
+(define pythagorean-triples (stream-filter (lambda (triple)
+                                             (let ((i (car triple))
+                                                   (j (cadr triple))
+                                                   (k (caddr triple)))
+                                               (pythagorean-triple? i j k)))
+                                           int-triples))
+
+(stream-display-n pythagorean-triples 10)

From 5a584a292d5a3939fd8350db649f295b509a9048 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 22 Sep 2013 21:47:55 +0800
Subject: [PATCH 25/75] c3 69 update

---
 src/stream-of-pairs.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
index 4ee8d31..aaf60d9 100644
--- a/src/stream-of-pairs.scm
+++ b/src/stream-of-pairs.scm
@@ -53,7 +53,7 @@
 
 ; (stream-display-n (louis-pairs integers integers) 10)
 
-; 3.69
+; 3.69 unfinished
 (define (triples s t u)
   (cons-stream (list (stream-car s)
                      (stream-car t)

From 57f2c4de81e55e6f13d2d27875d41ba64eb0edb1 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 23 Sep 2013 00:13:53 +0800
Subject: [PATCH 26/75] try progressive interleave, failed

---
 src/lib/stream.scm      | 11 ++++++++++-
 src/stream-of-pairs.scm | 34 ++++++++++++++++++++++++++++++----
 src/test.scm            | 11 ++---------
 3 files changed, 42 insertions(+), 14 deletions(-)

diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index 4f1e20d..1e17b0e 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -22,7 +22,8 @@
           stream-display-n
           stream-negate
           one-zeros
-          interleave)
+          interleave
+          stream-append)
 
   (import (rnrs)
           (utils))
@@ -54,6 +55,7 @@
 
   (define (stream-car stream) (car stream))
 
+
   (define (stream-cdr stream) (force (cdr stream)))
 
   (define the-empty-stream '())
@@ -61,6 +63,13 @@
   (define (stream-null? s)
     (null? s))
 
+  ; append s1 to s2, note s1 should not be infinite stream
+  (define (stream-append s1 s2)
+    (if (stream-null? s1)
+      s2
+      (cons-stream (stream-car s1)
+                   (stream-append (stream-cdr s1) s2))))
+
   ;  (define (stream-map proc s)
   ;(if (stream-null? s)
   ;the-empty-stream
diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
index aaf60d9..45ccc3a 100644
--- a/src/stream-of-pairs.scm
+++ b/src/stream-of-pairs.scm
@@ -4,15 +4,19 @@
         (prime))
 
 
-(define (pairs s t)
+(define (pairs-base s t interleave)
   (let ((s0 (stream-car s))
         (t0 (stream-car t)))
     (cons-stream (list s0 t0)
                  (interleave (stream-map (lambda (ti)
                                            (list s0 ti))
                                          (stream-cdr t))
-                             (pairs (stream-cdr s)
-                                    (stream-cdr t))))))
+                             (pairs-base (stream-cdr s)
+                                         (stream-cdr t)
+                                         interleave)))))
+
+(define (pairs s t)
+  (pairs-base s t interleave))
 
 (define int-pairs (pairs integers integers))
 
@@ -23,6 +27,28 @@
                  (interleave s2
                              (stream-cdr s1)))))
 
+;(define (progressive-interleave s1 s2 n1 n2)
+  ;(define (split-stream s n)
+    ;(define (iter s-cur s-rest n)
+      ;(cond ((or (= n 0)
+                 ;(stream-null? s-rest))
+             ;(list s-cur s-rest))
+            ;(else
+              ;(iter (stream-append s-cur
+                                   ;(list (stream-car s-rest)))
+                    ;(stream-cdr s-rest)
+                    ;(- n 1)))))
+    ;(iter the-empty-stream s n))
+
+  ;(let* ((s1-pair (split-stream s1 n1))
+         ;(s1-cur (car s1-pair))
+         ;(s1-rest (cadr s1-pair)))
+    ;(cond ((stream-null? s1-rest)
+           ;(stream-append s1-cur s2))
+          ;(else
+            ;(stream-append s1-cur
+                           ;(progressive-interleave s2 s1-rest n2 n1))))))
+
 (stream-ref (stream-filter (lambda (pair)
                              (prime? (+ (car pair)
                                         (cadr pair))))
@@ -74,4 +100,4 @@
                                                (pythagorean-triple? i j k)))
                                            int-triples))
 
-(stream-display-n pythagorean-triples 10)
+; (stream-display-n pythagorean-triples 5)
diff --git a/src/test.scm b/src/test.scm
index 8c6032a..239611f 100644
--- a/src/test.scm
+++ b/src/test.scm
@@ -2,12 +2,5 @@
         (stream)
         (utils))
 
-(define primes (cons-stream 2
-                            (stream-filter prime? (integers-start-from 3))))
-
-(define (prime? n)
-  (define (iter ps)
-    (cond ((> (square (stream-car ps)) n) #t)
-          ((divisible? n (stream-car ps)) #f)
-
-(println (stream-ref primes 50))
+(stream-display (stream-append (list-stream 1 2 3)
+                   (list-stream 2 3 4)))

From ffbc46701cded1263df00d0e9ed3b8c28e78c970 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 23 Sep 2013 01:17:42 +0800
Subject: [PATCH 27/75] c3 70

---
 src/stream-of-pairs.scm | 101 ++++++++++++++++++++++++++++------------
 1 file changed, 72 insertions(+), 29 deletions(-)

diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
index 45ccc3a..36fc21c 100644
--- a/src/stream-of-pairs.scm
+++ b/src/stream-of-pairs.scm
@@ -4,19 +4,16 @@
         (prime))
 
 
-(define (pairs-base s t interleave)
+(define (pairs s t)
   (let ((s0 (stream-car s))
         (t0 (stream-car t)))
     (cons-stream (list s0 t0)
                  (interleave (stream-map (lambda (ti)
                                            (list s0 ti))
                                          (stream-cdr t))
-                             (pairs-base (stream-cdr s)
-                                         (stream-cdr t)
-                                         interleave)))))
-
-(define (pairs s t)
-  (pairs-base s t interleave))
+                             (pairs (stream-cdr s)
+                                    (stream-cdr t)
+                                    )))))
 
 (define int-pairs (pairs integers integers))
 
@@ -27,28 +24,6 @@
                  (interleave s2
                              (stream-cdr s1)))))
 
-;(define (progressive-interleave s1 s2 n1 n2)
-  ;(define (split-stream s n)
-    ;(define (iter s-cur s-rest n)
-      ;(cond ((or (= n 0)
-                 ;(stream-null? s-rest))
-             ;(list s-cur s-rest))
-            ;(else
-              ;(iter (stream-append s-cur
-                                   ;(list (stream-car s-rest)))
-                    ;(stream-cdr s-rest)
-                    ;(- n 1)))))
-    ;(iter the-empty-stream s n))
-
-  ;(let* ((s1-pair (split-stream s1 n1))
-         ;(s1-cur (car s1-pair))
-         ;(s1-rest (cadr s1-pair)))
-    ;(cond ((stream-null? s1-rest)
-           ;(stream-append s1-cur s2))
-          ;(else
-            ;(stream-append s1-cur
-                           ;(progressive-interleave s2 s1-rest n2 n1))))))
-
 (stream-ref (stream-filter (lambda (pair)
                              (prime? (+ (car pair)
                                         (cadr pair))))
@@ -101,3 +76,71 @@
                                            int-triples))
 
 ; (stream-display-n pythagorean-triples 5)
+
+(define (weighted-pairs s t weight)
+  (let ((s0 (stream-car s))
+        (t0 (stream-car t)))
+    ; (s0 t0) must be the first, or there'll be problem for
+    ; the func
+    (cons-stream (list s0 t0)
+                 (merge-weighted (stream-map (lambda (ti)
+                                               (list s0 ti))
+                                             (stream-cdr t))
+                                 (weighted-pairs (stream-cdr s)
+                                                 (stream-cdr t)
+                                                 weight)
+                                 weight))))
+
+(define (merge-weighted s1 s2 weight)
+  (cond ((stream-null? s1) s2)
+        ((stream-null? s2) s1)
+        (else
+          (let ((s1car (stream-car s1))
+                (s2car (stream-car s2)))
+            ;(display s1car)(display " ")
+            ;(display s2car)(newline)
+            (cond ((weight s1car s2car)
+                   (cons-stream s1car
+                                (merge-weighted (stream-cdr s1)
+                                                s2
+                                                weight)))
+                  ((weight s2car s1car)
+                   (cons-stream s2car
+                                (merge-weighted s1
+                                                (stream-cdr s2)
+                                                weight)))
+                  (else
+                    (cons-stream s1car
+                                 (cons-stream s2car
+                                              (merge-weighted (stream-cdr s1)
+                                                              (stream-cdr s2)
+                                                              weight)))))))))
+
+; 3.70 a
+(define weighted-pairs-by-a (weighted-pairs integers integers (lambda (p1 p2)
+                                                                (< (+ (car p1)
+                                                                      (cadr p1))
+                                                                   (+ (car p2)
+                                                                      (cadr p2))))))
+
+(stream-ref weighted-pairs-by-a 10)
+
+; 3.70 b
+(define integer-not-divisible-235 (stream-filter (lambda (v)
+                                                            (not (or (divisible? v 2)
+                                                                     (divisible? v 3)
+                                                                     (divisible? v 5))))
+                                                 integers))
+
+(define weighted-pairs-by-b (weighted-pairs integer-not-divisible-235
+                                            integer-not-divisible-235
+                                            (lambda (p1 p2)
+                                              (define (sum-rule i j)
+                                                (+ (* 2 i)
+                                                   (* 3 j)
+                                                   (* 5 i j)))
+                                              (< (sum-rule (car p1)
+                                                           (cadr p1))
+                                                 (sum-rule (car p2)
+                                                           (cadr p2))))))
+; (stream-display-n weighted-pairs-by-b 10)

From 3ac3d363709ea2400fe12354a590660152216c0c Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 23 Sep 2013 11:41:23 +0800
Subject: [PATCH 28/75] c3 71;

---
 src/c3_71.scm           |  1 +
 src/lib/stream.scm      | 21 +++++++++++++++------
 src/lib/utils.scm       |  4 ++++
 src/stream-of-pairs.scm | 42 +++++++++++++++++++++++++++++++++++++----
 4 files changed, 58 insertions(+), 10 deletions(-)
 create mode 100644 src/c3_71.scm

diff --git a/src/c3_71.scm b/src/c3_71.scm
new file mode 100644
index 0000000..533c92e
--- /dev/null
+++ b/src/c3_71.scm
@@ -0,0 +1 @@
+; in stream-of-pairs.scm
diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index 1e17b0e..9b8c564 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -84,13 +84,22 @@
       (cons-stream (apply proc (map stream-car stream-args))
                    (apply stream-map (cons proc (map stream-cdr stream-args))))))
 
-  (define (stream-filter proc s)
-    (cond ((stream-null? s) the-empty-stream)
-          ((proc (stream-car s))
-           (cons-stream (stream-car s)
-                        (stream-filter proc (stream-cdr s))))
+  ;(define (stream-filter proc s)
+  ;(cond ((stream-null? s) the-empty-stream)
+  ;((proc (stream-car s))
+  ;(cons-stream (stream-car s)
+  ;(stream-filter proc (stream-cdr s))))
+  ;(else
+  ;(stream-filter proc (stream-cdr s)))))
+
+  
+  (define (stream-filter proc . stream-args)
+    (cond ((stream-null? (car stream-args)) the-empty-stream)
+          ((apply proc (map stream-car stream-args))
+           (cons-stream (map stream-car stream-args)
+                        (apply stream-filter (cons proc (map stream-cdr stream-args)))))
           (else
-            (stream-filter proc (stream-cdr s)))))
+            (apply stream-filter (cons proc (map stream-cdr stream-args))))))
 
   (define (stream-enumerate-interval low high)
     (if (> low high)
diff --git a/src/lib/utils.scm b/src/lib/utils.scm
index bbc4797..cea583f 100644
--- a/src/lib/utils.scm
+++ b/src/lib/utils.scm
@@ -2,6 +2,7 @@
 (library
   (utils)
   (export square
+          cube
           set-cadr!
           set-caddr!
           inlist?
@@ -23,6 +24,9 @@
   (define (square x)
     (* x x))
 
+  (define (cube x)
+    (* x x x))
+
   (define (inlist? x lst eqfn)
     (if (filter (lambda (y)
                   (eqfn x y))
diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
index 36fc21c..5bbe9d6 100644
--- a/src/stream-of-pairs.scm
+++ b/src/stream-of-pairs.scm
@@ -54,7 +54,7 @@
 
 ; (stream-display-n (louis-pairs integers integers) 10)
 
-; 3.69 unfinished
+; 3.69
 (define (triples s t u)
   (cons-stream (list (stream-car s)
                      (stream-car t)
@@ -75,6 +75,18 @@
                                                (pythagorean-triple? i j k)))
                                            int-triples))
 
+(define (weighted-triples s t u weight)
+  (cons-stream (list (stream-car s)
+                     (stream-car t)
+                     (stream-car u))
+               (merge-weighted (stream-map (lambda (pair)
+                                             (cons (stream-car s) pair))
+                                           (stream-cdr (pairs t u)))
+                               (triples (stream-cdr s)
+                                        (stream-cdr t)
+                                        (stream-cdr u)
+                                        weight)
+                               weight)))
 ; (stream-display-n pythagorean-triples 5)
 
 (define (weighted-pairs s t weight)
@@ -127,9 +139,9 @@
 
 ; 3.70 b
 (define integer-not-divisible-235 (stream-filter (lambda (v)
-                                                            (not (or (divisible? v 2)
-                                                                     (divisible? v 3)
-                                                                     (divisible? v 5))))
+                                                   (not (or (divisible? v 2)
+                                                            (divisible? v 3)
+                                                            (divisible? v 5))))
                                                  integers))
 
 (define weighted-pairs-by-b (weighted-pairs integer-not-divisible-235
@@ -144,3 +156,25 @@
                                                  (sum-rule (car p2)
                                                            (cadr p2))))))
 ; (stream-display-n weighted-pairs-by-b 10)
+
+(define (ramanujan-sum p)
+  (+ (cube (car p))
+     (cube (cadr p))))
+;3.71
+(define ramanujan-weighted-pairs (weighted-pairs integers
+                                                 integers
+                                                 (lambda (p1 p2)
+                                                   (< (ramanujan-sum p1)
+                                                      (ramanujan-sum p2)))))
+
+
+(define ramanujan-series (stream-filter (lambda (p1 p2)
+                                          (= (ramanujan-sum p1)
+                                             (ramanujan-sum p2)))
+                                        ramanujan-weighted-pairs
+                                        (stream-cdr ramanujan-weighted-pairs)))
+
+(stream-ref (stream-map (lambda (p)
+                          (ramanujan-sum (car p)))
+                        ramanujan-series)
+            5)

From 468073ddf6b90250e124406665eed11f1ccef771 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 23 Sep 2013 14:28:56 +0800
Subject: [PATCH 29/75] c3 72;

---
 src/c3_72.scm           |  1 +
 src/stream-of-pairs.scm | 24 ++++++++++++++++++++++++
 2 files changed, 25 insertions(+)
 create mode 100644 src/c3_72.scm

diff --git a/src/c3_72.scm b/src/c3_72.scm
new file mode 100644
index 0000000..533c92e
--- /dev/null
+++ b/src/c3_72.scm
@@ -0,0 +1 @@
+; in stream-of-pairs.scm
diff --git a/src/stream-of-pairs.scm b/src/stream-of-pairs.scm
index 5bbe9d6..d7598db 100644
--- a/src/stream-of-pairs.scm
+++ b/src/stream-of-pairs.scm
@@ -178,3 +178,27 @@
                           (ramanujan-sum (car p)))
                         ramanujan-series)
             5)
+
+; 3.72
+(define (square-sum p)
+  (+ (square (car p))
+     (square (cadr p))))
+(define square-sum-in-3-pairs (weighted-pairs integers
+                                              integers
+                                              (lambda (p1 p2)
+                                                (< (square-sum p1)
+                                                   (square-sum p2)))))
+
+(define square-sum-in-3-series (stream-filter (lambda (p1 p2 p3)
+                                           (= (square-sum p1)
+                                              (square-sum p2)
+                                              (square-sum p3)))
+                                         square-sum-in-3-pairs
+                                         (stream-cdr square-sum-in-3-pairs)
+                                         (stream-cdr (stream-cdr square-sum-in-3-pairs))))
+
+(stream-display-n (stream-map (lambda (t)
+                                (cons (square-sum (car t))
+                                      t))
+                              square-sum-in-3-series)
+                  5)

From 0d01824306f64c2b129280c501e1218f6261c104 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 23 Sep 2013 15:44:40 +0800
Subject: [PATCH 30/75] c3 73;

---
 src/c3_73.scm          |  1 +
 src/lib/stream.scm     | 13 +++++++++++--
 src/stream-signals.scm | 18 ++++++++++++++++++
 3 files changed, 30 insertions(+), 2 deletions(-)
 create mode 100644 src/c3_73.scm
 create mode 100644 src/stream-signals.scm

diff --git a/src/c3_73.scm b/src/c3_73.scm
new file mode 100644
index 0000000..07b08c6
--- /dev/null
+++ b/src/c3_73.scm
@@ -0,0 +1 @@
+; in stream-signals.scm
diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index 9b8c564..e1623e1 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -22,8 +22,10 @@
           stream-display-n
           stream-negate
           one-zeros
+          ones
           interleave
-          stream-append)
+          stream-append
+          integral)
 
   (import (rnrs)
           (utils))
@@ -92,7 +94,7 @@
   ;(else
   ;(stream-filter proc (stream-cdr s)))))
 
-  
+
   (define (stream-filter proc . stream-args)
     (cond ((stream-null? (car stream-args)) the-empty-stream)
           ((apply proc (map stream-car stream-args))
@@ -186,4 +188,11 @@
       (cons-stream (stream-car s1)
                    (interleave s2
                                (stream-cdr s1)))))
+
+  (define (integral integrand initial-value dt)
+    (define int
+      (cons-stream initial-value
+                   (stream-add (stream-scale integrand dt)
+                               int)))
+    int)
   )
diff --git a/src/stream-signals.scm b/src/stream-signals.scm
new file mode 100644
index 0000000..227b924
--- /dev/null
+++ b/src/stream-signals.scm
@@ -0,0 +1,18 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+; 3.73 (not fully understand it)
+
+(define (rc r c dt)
+  (lambda (I v0)
+    (stream-add (stream-scale (integral I v0 dt) (/ 1 c))
+                (stream-scale I r))
+    ))
+
+
+(define RC1 (rc 5 1 0.5))
+
+(define constant-current (RC1 ones 0))
+
+(stream-display-n constant-current 10)

From fe815b970fab25bcede7f7b2d8209676d519a5eb Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 23 Sep 2013 16:42:31 +0800
Subject: [PATCH 31/75] how implicit stream works

---
 src/how-implicit-stream-works.scm | 58 +++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)
 create mode 100644 src/how-implicit-stream-works.scm

diff --git a/src/how-implicit-stream-works.scm b/src/how-implicit-stream-works.scm
new file mode 100644
index 0000000..a54f7c0
--- /dev/null
+++ b/src/how-implicit-stream-works.scm
@@ -0,0 +1,58 @@
+; take partial-sum as example
+
+(define (partial-sum s)
+  (define sum (cons-stream (stream-car s)
+                           (stream-add (stream-cdr s)
+                                       sum)))
+  sum)
+
+(define ones (cons-stream 1 ones))
+
+(partial-sum ones) ->
+
+(partial-sum (cons-stream 1 ones)) ->
+
+(cons-stream (stream-car (cons-stream 1 ones))
+             (stream-add (stream-cdr (cons-stream 1 ones)
+                         sum)) ->
+
+; intepret first args of stream-add
+(cons-stream 1
+             (stream-add (cons-stream 1 ones)
+                         sum)) ->
+
+; interpret second args of stream-add
+; use ... to replace the delayed part of sum
+(cons-stream 1
+             (stream-add (cons-stream 1 ones)
+                         (cons-stream 1 ...))) ->
+
+(cons-stream 1
+             (cons-stream (+ (stream-car (cons-stream 1 ones))
+                             (stream-car (cons-stream 1 ...)))
+                          (stream-map +
+                                      (stream-cdr (cons-stream 1 ones))
+                                      (stream-cdr (cons-stream 1 ...))))) ->
+
+(cons-stream 1
+             (cons-stream 2
+                          (stream-map +
+                                      (cons-stream 1 ones)
+                                      (cons-stream 2 ...))))  ->
+
+(cons-stream 1
+             (cons-stream 2
+                          (cons-stream (+ (stream-car (cons-stream 1 ones))
+                                          (stream-car (cons-stream 2 ...)))
+                                       (stream-map +
+                                                   (stream-cdr (cons-stream 1 ones))
+                                                   (stream-cdr (cons-stream 2 ...)))))) ->
+
+(cons-stream 1
+             (cons-stream 2
+                          (cons-stream 3
+                                       (stream-map +
+                                                   (cons-stream 1 ones)
+                                                   (cons-stream 3 ...)))))
+
+...

From e7505faa2c4eb8e033029ef9fb145ce7b8e52ce4 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 23 Sep 2013 19:25:32 +0800
Subject: [PATCH 32/75] c3 77,78,79

---
 src/c3_77.scm            |  1 +
 src/c3_78.scm            |  1 +
 src/c3_79.scm            |  1 +
 src/delayed-integral.scm | 59 ++++++++++++++++++++++++++++++++++++++++
 src/lib/stream.scm       | 24 +++++++++++++---
 src/stream-signals.scm   |  4 ++-
 6 files changed, 85 insertions(+), 5 deletions(-)
 create mode 100644 src/c3_77.scm
 create mode 100644 src/c3_78.scm
 create mode 100644 src/c3_79.scm
 create mode 100644 src/delayed-integral.scm

diff --git a/src/c3_77.scm b/src/c3_77.scm
new file mode 100644
index 0000000..ac12b0a
--- /dev/null
+++ b/src/c3_77.scm
@@ -0,0 +1 @@
+; in delayed-integral.scm
diff --git a/src/c3_78.scm b/src/c3_78.scm
new file mode 100644
index 0000000..ac12b0a
--- /dev/null
+++ b/src/c3_78.scm
@@ -0,0 +1 @@
+; in delayed-integral.scm
diff --git a/src/c3_79.scm b/src/c3_79.scm
new file mode 100644
index 0000000..ac12b0a
--- /dev/null
+++ b/src/c3_79.scm
@@ -0,0 +1 @@
+; in delayed-integral.scm
diff --git a/src/delayed-integral.scm b/src/delayed-integral.scm
new file mode 100644
index 0000000..b57d1d0
--- /dev/null
+++ b/src/delayed-integral.scm
@@ -0,0 +1,59 @@
+(import (rnrs)
+        (rnrs r5rs)
+        (stream))
+
+(define (solve f y0 dt)
+  (define y (integral-delayed (delay dy) y0 dt))
+  (define dy (stream-map f y))
+  y)
+
+; y = e^x
+(display (stream-ref (solve (lambda (y) y) 1 0.001) 1000))(newline)
+
+
+; 3.77
+(define (integral-recur delayed-integrand initial-value dt)
+  (cons-stream initial-value
+               (let ((integrand (force delayed-integrand)))
+                 (if (stream-null? integrand)
+                   the-empty-stream
+                   (integral-recur (delay (stream-cdr integrand))
+                                   (+ (* dt (stream-car integrand))
+                                      initial-value)
+                                   dt)))))
+
+(define (solve-use-recur f y0 dt)
+  (define y(integral-recur (delay dy) y0 dt))
+  (define dy (stream-map f y))
+  y)
+
+(stream-ref (solve-use-recur (lambda (y) y) 1 0.001) 1000)
+
+; 3.78
+(define (solve-2nd a b dt y0 dy0)
+  (define y (integral-delayed (delay dy) y0 dt))
+  (define dy (integral-delayed (delay ddy) dy0 dt))
+  (define ddy (stream-add (stream-scale dy a)
+                          (stream-scale y b)))
+  y)
+
+; y = e^x, solve value at x = 1000 * 0.001 = 1
+(display (stream-ref (solve-2nd 2 -1 0.001 1 1) 1000))(newline)
+; 3.79
+
+(define (solve-2nd-general f y0 dy0 dt)
+  (define y (integral-delayed (delay dy) y0 dt))
+  (define dy (integral-delayed (delay ddy) dy0 dt))
+  (define ddy (stream-map f dy y))
+  y)
+
+; y = e^x, f(dy,y) = 2*dy - y
+(display (stream-ref (solve-2nd-general (lambda (dy y)
+                                 (- (* 2 dy)
+                                    y))
+                               1
+                               1
+                               0.001)
+            1000))(newline)
+
+; 3.80 unfinished
diff --git a/src/lib/stream.scm b/src/lib/stream.scm
index e1623e1..ac2154d 100644
--- a/src/lib/stream.scm
+++ b/src/lib/stream.scm
@@ -25,9 +25,11 @@
           ones
           interleave
           stream-append
-          integral)
+          integral
+          integral-delayed)
 
   (import (rnrs)
+          (rnrs r5rs)
           (utils))
 
   (define (memo-proc proc)
@@ -39,13 +41,19 @@
                  result)
           result))))
 
-  (define (force delayed-object)
-    (delayed-object))
+  ;(define (force delayed-object)
+  ;(delayed-object))
+
 
   (define-syntax cons-stream
     (syntax-rules ()
                   ((cons-stream a b)
-                   (cons a (memo-proc (lambda () b))))))
+                   (cons a (memo-proc (delay b))))))
+
+  ;(define-syntax delay
+  ;(syntax-rules ()
+  ;((_ v) (lambda () v))))
+
   ;(cons a (lambda () b)))))
 
   (define-syntax list-stream
@@ -195,4 +203,12 @@
                    (stream-add (stream-scale integrand dt)
                                int)))
     int)
+
+  (define (integral-delayed delayed-integrand initial-value dt)
+    (define int
+      (cons-stream initial-value
+                   (let ((integrand (force delayed-integrand)))
+                     (stream-add (stream-scale integrand dt)
+                                 int))))
+    int)
   )
diff --git a/src/stream-signals.scm b/src/stream-signals.scm
index 227b924..ce5bd41 100644
--- a/src/stream-signals.scm
+++ b/src/stream-signals.scm
@@ -2,7 +2,7 @@
         (stream)
         (utils))
 
-; 3.73 (not fully understand it)
+; 3.73 (not really understand it)
 
 (define (rc r c dt)
   (lambda (I v0)
@@ -16,3 +16,5 @@
 (define constant-current (RC1 ones 0))
 
 (stream-display-n constant-current 10)
+
+; 3.74, 3.75, 3.76 unfinished

From ad544d1169e53ba311c0a3653f2a6ebf1bb3292d Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 23 Sep 2013 20:28:29 +0800
Subject: [PATCH 33/75] functional view of time

---
 src/functional-time.scm | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)
 create mode 100644 src/functional-time.scm

diff --git a/src/functional-time.scm b/src/functional-time.scm
new file mode 100644
index 0000000..868edfd
--- /dev/null
+++ b/src/functional-time.scm
@@ -0,0 +1,18 @@
+(import (rnrs)
+        (stream)
+        (utils))
+
+(define (make-simplified-withdraw balance)
+  (lambda (amount)
+    (set! balance (- balance amount))
+    balance))
+
+(define (stream-widthdraw balance amount-stream)
+  (define balance-stream
+    (cons-stream balance
+                 (stream-minus balance-stream
+                               amount-stream)))
+  balance-stream)
+
+(let ((bs (stream-widthdraw 1000 (list-stream 1 2 3 4))))
+  (display (stream-ref bs 4)))

From 80c581463fdd7aa980661af72f5d661cc4eaa17c Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 23 Sep 2013 20:28:45 +0800
Subject: [PATCH 34/75] modularity brought by stream

---
 src/modularity-functional.scm | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 src/modularity-functional.scm

diff --git a/src/modularity-functional.scm b/src/modularity-functional.scm
new file mode 100644
index 0000000..bbac37a
--- /dev/null
+++ b/src/modularity-functional.scm
@@ -0,0 +1 @@
+; no rand-init/rand-update for chez-scheme...

From 0db2770d09a82ea37bbf831ef2ae4e6a18e13f27 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Wed, 25 Sep 2013 22:42:31 +0800
Subject: [PATCH 35/75] rand for petite scheme

---
 src/lib/rand.scm | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)
 create mode 100644 src/lib/rand.scm

diff --git a/src/lib/rand.scm b/src/lib/rand.scm
new file mode 100644
index 0000000..cd381da
--- /dev/null
+++ b/src/lib/rand.scm
@@ -0,0 +1,19 @@
+(library
+  (rand)
+  (import (chezscheme))
+  (export rand
+          random-init
+          random-update)
+  (define random-init (time-second (current-time)))
+  (define (random-update x)
+    (let ((a 40)
+          (b 2641)
+          (m 729))
+      (modulo (+ (* a x) b) m)))
+
+  (define rand
+    (let ((x random-init))
+      (lambda ()
+        (set! x (rand-update x))
+        x)))
+  )

From 7b5b85177d1f115ed6f66ecce432ab4d98c2c99a Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Wed, 25 Sep 2013 22:42:38 +0800
Subject: [PATCH 36/75] rand for mit scheme

---
 src/rand.scm | 15 +++++++++++++++
 1 file changed, 15 insertions(+)
 create mode 100644 src/rand.scm

diff --git a/src/rand.scm b/src/rand.scm
new file mode 100644
index 0000000..580f8d8
--- /dev/null
+++ b/src/rand.scm
@@ -0,0 +1,15 @@
+; rand.scm for mit-scheme
+(define random-init (get-universal-time))
+(define (rand-update x)
+  (let ((a 40)
+        (b 2641)
+        (m 729))
+    (modulo (+ (* a x) b) m)))
+
+(define rand
+  (let ((x random-init))
+    (lambda ()
+      (set! x (rand-update x))
+      x)))
+
+(display (rand))

From 2358135a01e8d5a9e058f0c1659e10100d497c29 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Wed, 25 Sep 2013 22:42:56 +0800
Subject: [PATCH 37/75] metacircular evaluator

---
 src/eval/eval.scm       | 165 ++++++++++++++++++++++++++++++++++++++++
 src/eval/run-test.sh    |   9 +++
 src/eval/utils/dict.scm |  78 +++++++++++++++++++
 src/lib/dict.scm        |  10 ++-
 src/run-test.sh         |   4 +-
 5 files changed, 264 insertions(+), 2 deletions(-)
 create mode 100644 src/eval/eval.scm
 create mode 100755 src/eval/run-test.sh
 create mode 100644 src/eval/utils/dict.scm

diff --git a/src/eval/eval.scm b/src/eval/eval.scm
new file mode 100644
index 0000000..7bf3797
--- /dev/null
+++ b/src/eval/eval.scm
@@ -0,0 +1,165 @@
+(load "./dict.scm")
+
+(define (seck-eval exp env)
+  (cond ((application? exp)
+         (seck-apply (seck-eval (operator exp) env)
+                     (list-of-values (operand exp) env)))))
+
+(define (tagged-list? exp tag)
+  (if (pair? exp)
+    (eq? (car exp) tag)
+    #f))
+
+(define application? pair?)
+(define (operator exp) (car exp))
+(define (operand exp) (cdr exp))
+(define (first-operand exps) (car exps))
+(define (rest-operands exps) (cdr exps))
+(define (list-of-values exps env)
+  (if (null? exps)
+    '()
+    (cons (seck-eval (first-operand exps) env)
+          (list-of-values (rest-operands exps) env))))
+(define (seck-apply procedure arguments)
+  (cond ((primitive-procedure? procedure)
+         (apply-primitive-procedure procedure arguments))
+        ((compound-procedure? procedure)
+         (eval-sequence
+           (procedure-body procedure)
+           (extend-environment
+             (procedure-parameters procedure)
+             arguments
+             (procedure-environment procedure))))
+        (else
+          (error
+            'seck-apply
+            "Inknown procedure type" procedure))))
+
+; @(environment)
+
+(define (make-env base)
+  (let ((local-env (list (make-dict) base)))
+    (define (cur-env-var-dict) (car local-env))
+    (define (base-env) (cadr local-env))
+
+    (define (lookup var)
+      (let ((ret (dict-lookup (cur-env-var-dict) var)))
+        (let ((found (car ret))
+              (value (cadr ret)))
+          (cond (found value)
+                ((null? (base-env))
+                 (error 'lookup "variable not defined" var))
+                (else
+                  (((base-env) 'lookup) var))))))
+
+    (define (insert! var value)
+      (dict-insert! (cur-env-var-dict) var value))
+
+    (define (set! var value)
+      (if (dict-set! (cur-env-var-dict) var value)
+        value
+        (error 'set! "setting an unbound value for " var)))
+
+    (define (dispatch action)
+      (cond ((eq? action 'lookup) lookup)
+            ((eq? action 'insert) insert!)
+            (else
+              (error 'make-env-dispatch "unknown action" action))))
+    dispatch))
+
+(define (lookup-variable-value var env)
+  ((env 'lookup) var))
+
+(define (extend-environment vars values base-env)
+  (let ((new-env (make-env base-env)))
+    (define (iter vars values)
+      (cond ((and (null? vars)
+                  (null? values))
+             new-env)
+            ((or (null? vars)
+                 (null? values))
+             (error 'extend-environment "vars and values should have equal lenght"))
+            (else
+              ((new-env 'insert) (car vars) (car values))
+              (iter (cdr vars) (cdr values)))))
+    (iter vars values)))
+
+(define (define-variable! var value env)
+  ((env 'insert) var value))
+
+(define (set-variable-value! var value env)
+  ((env 'insert) var value))
+
+(define the-empty-env '())
+
+(define (setup-environment)
+  (extend-environment (primitive-names)
+                              (primitive-values)
+                              the-empty-env))
+
+(define global-env (setup-environment))
+
+; @(primitives)
+
+(define primitive-procedures
+  (list (list 'car car)
+        (list 'cdr cdr)
+        (list 'cons cons)
+        (list 'null? null?)
+        (list '+ +)
+        (list '- -)
+        (list '* *)
+        (list '/ /)
+        ))
+
+(define (primitive-procedure-names)
+  (map car
+       primitive-procedures))
+
+(define (primitive-procedure-objects)
+  (map (lambda (proc) (list 'primitive (cadr proc)))
+       primitive-procedures))
+
+(define primitive-vars
+  (list (list '#t #t)
+        (list '#f #f)
+        ))
+
+(define (primitive-var-names)
+  (map car
+       primitive-vars))
+
+(define (primitive-var-values)
+  (map cadr
+       primitive-vars))
+
+(define (primitive-names)
+  (append (primitive-procedure-names)
+          (primitive-var-names)))
+
+(define (primitive-values)
+  (append (primitive-procedure-objects)
+          (primitive-var-values)))
+
+(define (primitive-procedure? proc)
+  (tagged-list? proc 'primitive))
+
+(define (apply-primitive-procedure proc args)
+  (apply proc args))
+
+; @(procedures)
+
+(define (compound-procedure? proc)
+  (tagged-list? proc 'procedure))
+
+(define (make-procedure params body env)
+  (list 'procedure params body env))
+
+(define (procedure-parameters proc)
+  (cadr proc))
+
+(define (procedure-body proc)
+  (caddr proc))
+
+(define (procedure-env proc)
+  (cadddr proc))
diff --git a/src/eval/run-test.sh b/src/eval/run-test.sh
new file mode 100755
index 0000000..c99cd75
--- /dev/null
+++ b/src/eval/run-test.sh
@@ -0,0 +1,9 @@
+filename=$1
+filetype=${1##*.}
+if [ $filetype != "scm" ]
+then
+    filename=$filename.scm
+fi
+#petite --libdirs lib --script $filename
+
+csi -q -I lib -s $filename
diff --git a/src/eval/utils/dict.scm b/src/eval/utils/dict.scm
new file mode 100644
index 0000000..55b230b
--- /dev/null
+++ b/src/eval/utils/dict.scm
@@ -0,0 +1,78 @@
+(define (make-dict)
+  (let ((local-table (list '*table*)))
+    (define (record-key record) (car record))
+    (define (record-value record) (cdr record))
+    (define (set-record-value! record value)
+      (set-cdr! record value))
+    (define (make-record k v) (cons k v))
+    (define (empty? table)
+      (null? (cdr table)))
+    (define (lookup-record k)
+      (define (iter table-records)
+        (cond ((null? table-records)
+               ; not found
+               (list #f '()))
+              ((eq? k (record-key (car table-records)))
+               (list #t (car table-records)))
+              (else
+                (iter (cdr table-records)))))
+      (iter (cdr local-table)))
+
+    ; return (list found record)
+    (define (lookup k)
+      (let* ((ret (lookup-record k))
+             (found (car ret))
+             (record (cadr ret)))
+        (if found
+          (list #t (record-value record))
+          (list #f '()))
+        ))
+
+    ; return true when insert a new record,
+    ; return false when a record is modified
+    (define (insert! key value)
+      (let* ((ret (lookup-record key))
+             (found (car ret))
+             (record (cadr ret)))
+        (if found
+          (set-record-value! record value)
+          (set-cdr! local-table (cons (make-record key value)
+                                      (cdr local-table))))
+        (not found)))
+
+    ; return true when the record is found and set
+    ; return false when the record is not found.
+    ; difference between set! and insert! is that insert! will
+    ; insert a new record when the record doesn't exist.
+    (define (set! key value)
+      (let* ((ret (lookup-record key))
+             (found (car ret))
+             (record (cadr ret)))
+        (if found
+          (set-record-value! record value)
+          #f)))
+
+    (define (keys)
+      (map car (cdr local-table)))
+
+    ; randomly return a key
+    (define (akey)
+      (record-key (car (cdr local-table))))
+
+    (define (dispatch action)
+      (cond ((eq? action 'lookup) lookup)
+            ((eq? action 'insert) insert!)
+            ((eq? action 'set) set!)
+            ((eq? action 'keys) keys)
+            ((eq? action 'akey) akey)
+            (else (error 'dict-dispatch "UNKNOWN ACTION" action))))
+    dispatch))
+
+(define (dict-lookup d key)
+  ((d 'lookup) key))
+
+(define (dict-insert! d key value)
+  ((d 'insert) key value))
+
+(define (dict-set! d key value)
+  ((d 'set) key value))
diff --git a/src/lib/dict.scm b/src/lib/dict.scm
index 3465484..de74bbf 100644
--- a/src/lib/dict.scm
+++ b/src/lib/dict.scm
@@ -1,6 +1,8 @@
 (library
   (dict)
-  (export make-dict)
+  (export make-dict
+          dict-lookup
+          dict-insert!)
   (import (rnrs)
           (rnrs mutable-pairs))
   (define (make-dict)
@@ -36,4 +38,10 @@
               ((eq? action 'akey) akey)
               (else (error 'dict-dispatch "UNKNOWN ACTION" action))))
       dispatch))
+
+  (define (dict-lookup d key)
+    ((d 'lookup) key))
+
+  (define (dict-insert! d key value)
+    ((d 'insert) key value))
   )
diff --git a/src/run-test.sh b/src/run-test.sh
index 9693044..c99cd75 100755
--- a/src/run-test.sh
+++ b/src/run-test.sh
@@ -4,4 +4,6 @@ if [ $filetype != "scm" ]
 then
     filename=$filename.scm
 fi
-petite --libdirs lib --script $filename
+#petite --libdirs lib --script $filename
+
+csi -q -I lib -s $filename

From b57c6b24124c51678b6ed612bd58436340b6d614 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 10:58:12 +0800
Subject: [PATCH 38/75] eval for primitive procedures

---
 src/eval/eval.scm | 41 +++++++++++++++++++++++++++++++----------
 1 file changed, 31 insertions(+), 10 deletions(-)

diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 7bf3797..5cb4131 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -1,7 +1,9 @@
-(load "./dict.scm")
+(load "./utils/dict.scm")
 
 (define (seck-eval exp env)
-  (cond ((application? exp)
+  (cond ((self-evaluating? exp) exp)
+        ((variable? exp) (lookup-variable-value exp env))
+        ((application? exp)
          (seck-apply (seck-eval (operator exp) env)
                      (list-of-values (operand exp) env)))))
 
@@ -10,6 +12,14 @@
     (eq? (car exp) tag)
     #f))
 
+(define (self-evaluating? exp)
+  (cond ((number? exp) #t)
+        ((string? exp) #t)
+        (else #f)))
+
+(define (variable? exp)
+  (symbol? exp))
+
 (define application? pair?)
 (define (operator exp) (car exp))
 (define (operand exp) (cdr exp))
@@ -22,7 +32,7 @@
           (list-of-values (rest-operands exps) env))))
 (define (seck-apply procedure arguments)
   (cond ((primitive-procedure? procedure)
-         (apply-primitive-procedure procedure arguments))
+         (apply-primitive-procedure (primitive-proc-impl procedure) arguments))
         ((compound-procedure? procedure)
          (eval-sequence
            (procedure-body procedure)
@@ -92,13 +102,6 @@
 
 (define the-empty-env '())
 
-(define (setup-environment)
-  (extend-environment (primitive-names)
-                              (primitive-values)
-                              the-empty-env))
-
-(define global-env (setup-environment))
-
 ; @(primitives)
 
 (define primitive-procedures
@@ -120,6 +123,9 @@
   (map (lambda (proc) (list 'primitive (cadr proc)))
        primitive-procedures))
 
+(define (primitive-proc-impl proc)
+  (cadr proc))
+
 (define primitive-vars
   (list (list '#t #t)
         (list '#f #f)
@@ -163,3 +169,18 @@
 
 (define (procedure-env proc)
   (cadddr proc))
+
+
+
+; @(global env)
+(define (setup-environment)
+  (extend-environment (primitive-names)
+                              (primitive-values)
+                              the-empty-env))
+
+(define global-env (setup-environment))
+
+(define (test-eval)
+  (assert (= (seck-eval '(+ 1 2) global-env) 3))
+  (assert (equal? (seck-eval '(cons 1 2) global-env) (cons 1 2)))
+  )

From 405ad3e2131edac7a089c52563b7df9916eac390 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 11:44:42 +0800
Subject: [PATCH 39/75] lambda, procedures for eval

---
 src/eval/eval.scm | 174 ++++++++++++++++++++++++++++++++++++----------
 1 file changed, 138 insertions(+), 36 deletions(-)

diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 5cb4131..8169bf8 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -3,48 +3,23 @@
 (define (seck-eval exp env)
   (cond ((self-evaluating? exp) exp)
         ((variable? exp) (lookup-variable-value exp env))
+        ((assignment? exp) (eval-assignment exp env))
+        ((definition? exp) (eval-definition exp env))
+        ((lambda? exp)
+         (make-procedure (lambda-params exp)
+                         (lambda-body exp)
+                         env))
         ((application? exp)
          (seck-apply (seck-eval (operator exp) env)
                      (list-of-values (operand exp) env)))))
 
+
+; @(tools)
 (define (tagged-list? exp tag)
   (if (pair? exp)
     (eq? (car exp) tag)
     #f))
 
-(define (self-evaluating? exp)
-  (cond ((number? exp) #t)
-        ((string? exp) #t)
-        (else #f)))
-
-(define (variable? exp)
-  (symbol? exp))
-
-(define application? pair?)
-(define (operator exp) (car exp))
-(define (operand exp) (cdr exp))
-(define (first-operand exps) (car exps))
-(define (rest-operands exps) (cdr exps))
-(define (list-of-values exps env)
-  (if (null? exps)
-    '()
-    (cons (seck-eval (first-operand exps) env)
-          (list-of-values (rest-operands exps) env))))
-(define (seck-apply procedure arguments)
-  (cond ((primitive-procedure? procedure)
-         (apply-primitive-procedure (primitive-proc-impl procedure) arguments))
-        ((compound-procedure? procedure)
-         (eval-sequence
-           (procedure-body procedure)
-           (extend-environment
-             (procedure-parameters procedure)
-             arguments
-             (procedure-environment procedure))))
-        (else
-          (error
-            'seck-apply
-            "Inknown procedure type" procedure))))
-
 ; @(environment)
 
 (define (make-env base)
@@ -102,6 +77,45 @@
 
 (define the-empty-env '())
 
+; @(expression)
+
+(define (first-exp exps)
+  (car exps))
+
+(define (rest-exps exps)
+  (cdr exps))
+
+(define (last-exp? exps)
+  (and (pair? exps)
+       (null? (cdr exps))))
+
+(define (begin? exp)
+  (tagged-list? exp 'begin))
+
+(define (begin-actions exp)
+  (cdr exp))
+
+; implicit begin
+(define (sequence->exp seq)
+  (cond ((null? seq) seq)
+        ((last-exp? seq) (first-exp seq))
+        (else
+          (make-begin seq))))
+
+(define (make-begin seq)
+  (cons 'begin seq))
+
+; @(self-evaluating)
+(define (self-evaluating? exp)
+  (cond ((number? exp) #t)
+        ((string? exp) #t)
+        (else #f)))
+
+(define (variable? exp)
+  (symbol? exp))
+
+
+
 ; @(primitives)
 
 (define primitive-procedures
@@ -158,8 +172,8 @@
 (define (compound-procedure? proc)
   (tagged-list? proc 'procedure))
 
-(define (make-procedure params body env)
-  (list 'procedure params body env))
+(define (make-procedure params body-seq env)
+  (list 'procedure params body-seq env))
 
 (define (procedure-parameters proc)
   (cadr proc))
@@ -170,7 +184,88 @@
 (define (procedure-env proc)
   (cadddr proc))
 
+(define (eval-sequence exps env)
+  (if (last-exp? exps)
+    (seck-eval (first-exp exps) env)
+    (eval-sequence (rest-exps) env)))
+
+; @(assignment)
+
+(define (assignment? exp)
+  (tagged-list? exp 'set!))
+
+(define (assignment-var exp)
+  (cadr exp))
+
+(define (assignment-value exp)
+  (caddr exp))
+
+(define (eval-assignment exp env)
+  (set-variable-value! (assignment-var exp)
+                       (seck-eval (assignment-value exp) env)
+                       env))
+
+; @(defintion)
 
+(define (definition? exp)
+  (tagged-list? exp 'define))
+
+(define (definition-var exp)
+  (if (symbol? (cadr exp))
+    (cadr exp)
+    (caadr exp)))
+
+(define (definition-value exp)
+  (if (symbol? (cadr exp))
+    (caddr exp)
+    (make-lambda (cdadr exp)
+                 (cddr exp))))
+
+(define (eval-definition exp env)
+  (define-variable! (definition-var exp)
+                    (seck-eval (definition-value exp) env)
+                    env))
+
+; @(lambda)
+
+(define (lambda? exp)
+  (tagged-list? exp 'lambda))
+
+(define (make-lambda params body-seq)
+  (cons 'lambda (cons params body-seq)))
+
+(define (lambda-params exp)
+  (cadr exp))
+
+(define (lambda-body exp)
+  (cddr exp))
+
+
+; @(application)
+(define application? pair?)
+(define (operator exp) (car exp))
+(define (operand exp) (cdr exp))
+(define (first-operand exps) (car exps))
+(define (rest-operands exps) (cdr exps))
+(define (list-of-values exps env)
+  (if (null? exps)
+    '()
+    (cons (seck-eval (first-operand exps) env)
+          (list-of-values (rest-operands exps) env))))
+(define (seck-apply procedure arguments)
+  (cond ((primitive-procedure? procedure)
+         (apply-primitive-procedure (primitive-proc-impl procedure) arguments))
+        ((compound-procedure? procedure)
+         (eval-sequence
+           (procedure-body procedure)
+           (extend-environment
+             (procedure-parameters procedure)
+             arguments
+             (procedure-env procedure))))
+        (else
+          (error
+            'seck-apply
+            "Inknown procedure type" procedure))))
 
 ; @(global env)
 (define (setup-environment)
@@ -183,4 +278,11 @@
 (define (test-eval)
   (assert (= (seck-eval '(+ 1 2) global-env) 3))
   (assert (equal? (seck-eval '(cons 1 2) global-env) (cons 1 2)))
-  )
+  (let ((new-env (make-env global-env)))
+    (seck-eval '(define a 3) new-env)
+    (seck-eval '(set! a 4) new-env)
+    (assert (= (seck-eval 'a new-env) 4))
+    (seck-eval '(define (mycons a b) (cons a b)) new-env)
+    (assert (equal? (seck-eval '(mycons 1 2) new-env)
+                    (cons 1 2)))
+    ))

From 7746646c9b725071495cbb350e99c1394d43b213 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 14:12:06 +0800
Subject: [PATCH 40/75] conditional for eval

---
 src/eval/eval.scm | 98 ++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 93 insertions(+), 5 deletions(-)

diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 8169bf8..78fe4c7 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -3,12 +3,17 @@
 (define (seck-eval exp env)
   (cond ((self-evaluating? exp) exp)
         ((variable? exp) (lookup-variable-value exp env))
+        ((quoted? exp) (text-of-quotation exp))
         ((assignment? exp) (eval-assignment exp env))
         ((definition? exp) (eval-definition exp env))
+        ((if? exp) (eval-if exp env))
         ((lambda? exp)
          (make-procedure (lambda-params exp)
                          (lambda-body exp)
                          env))
+        ((begin? exp)
+         (eval-sequence (begin-actions exp) env))
+        ((cond? exp) (seck-eval (cond->if exp) env))
         ((application? exp)
          (seck-apply (seck-eval (operator exp) env)
                      (list-of-values (operand exp) env)))))
@@ -115,6 +120,13 @@
   (symbol? exp))
 
 
+; @(quote)
+
+(define (quoted? exp)
+  (tagged-list? exp 'quote))
+
+(define (text-of-quotation exp)
+  (cadr exp))
 
 ; @(primitives)
 
@@ -127,6 +139,8 @@
         (list '- -)
         (list '* *)
         (list '/ /)
+        (list '> >)
+        (list '< <)
         ))
 
 (define (primitive-procedure-names)
@@ -226,6 +240,66 @@
                     (seck-eval (definition-value exp) env)
                     env))
 
+; @(if)
+
+(define (make-if predicate consequent . args)
+  (if (null? args)
+    (list 'if predicate consequent '#f)
+    (list 'if predicate consequent (car args))))
+
+(define (if? exp)
+  (tagged-list? exp 'if))
+
+(define (if-predicate exp)
+  (cadr exp))
+
+(define (if-consequent exp)
+  (caddr exp))
+
+(define (if-alternative exp)
+  (if (not (null? (cdddr exp)))
+    (cadddr exp)
+    '#f))
+
+(define (eval-if exp env)
+  (if (seck-eval (if-predicate exp) env)
+    (seck-eval (if-consequent exp) env)
+    (seck-eval (if-alternative exp) env)))
+
+; @(cond)
+(define (cond? exp)
+  (tagged-list? exp 'cond))
+
+(define (cond-firstmatch matches)
+  (car matches))
+(define (cond-restmatches matches)
+  (cdr matches))
+(define (cond-lastmatch matches)
+  (null? (cdr matches)))
+(define (cond-elsematch? match)
+  (eq? (car match) 'else))
+
+(define (cond-match-predicate match)
+  (car match))
+
+(define (cond-match-actions match)
+  (cdr match))
+
+(define (cond->if exp)
+  (define (expand matches)
+    (if (null? matches)
+      '#f
+      (let ((first (cond-firstmatch matches))
+            (rest (cond-restmatches matches)))
+        (if (cond-elsematch? first)
+          (if (null? rest)
+            (make-if #t (sequence->exp (cond-match-actions first)))
+            (error 'cond "else is not last match"))
+          (make-if (cond-match-predicate first)
+                   (sequence->exp (cond-match-actions first))
+                   (expand rest))))))
+  (expand (cdr exp)))
+
 ; @(lambda)
 
 (define (lambda? exp)
@@ -270,8 +344,8 @@
 ; @(global env)
 (define (setup-environment)
   (extend-environment (primitive-names)
-                              (primitive-values)
-                              the-empty-env))
+                      (primitive-values)
+                      the-empty-env))
 
 (define global-env (setup-environment))
 
@@ -282,7 +356,21 @@
     (seck-eval '(define a 3) new-env)
     (seck-eval '(set! a 4) new-env)
     (assert (= (seck-eval 'a new-env) 4))
-    (seck-eval '(define (mycons a b) (cons a b)) new-env)
-    (assert (equal? (seck-eval '(mycons 1 2) new-env)
-                    (cons 1 2)))
+    (seck-eval '(define (op a b)
+                  (if (> a b)
+                    (- a b)
+                    (- b a)))
+               new-env)
+    (seck-eval '(define (op2 a b)
+                  (cond ((> a b)
+                         (- a b))
+                        ((> b a)
+                         (- b a))
+                        (else
+                          (+ a b))))
+               new-env)
+    (assert (equal? (seck-eval '(op 1 2) new-env)
+                    1))
+    (assert (equal? (seck-eval '(op2 2 2) new-env)
+                    4))
     ))

From 5188e8d78652c58a66ad7e028b0668cba3bc73a8 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 14:39:06 +0800
Subject: [PATCH 41/75] c4 1

---
 src/eval/c4_1.scm | 9 +++++++++
 src/eval/eval.scm | 6 ++++--
 2 files changed, 13 insertions(+), 2 deletions(-)
 create mode 100644 src/eval/c4_1.scm

diff --git a/src/eval/c4_1.scm b/src/eval/c4_1.scm
new file mode 100644
index 0000000..f627634
--- /dev/null
+++ b/src/eval/c4_1.scm
@@ -0,0 +1,9 @@
+
+(define (list-of-values-left-to-right exps env)
+  (if (null? exps)
+    '()
+    (let ((first-value (seck-eval (first-operand exps) env)))
+      (cons first-value
+            (list-of-values-left-to-right (rest-operands exps) env)))))
+
+;; right-to-left is just the same
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 78fe4c7..15505ec 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -16,8 +16,9 @@
         ((cond? exp) (seck-eval (cond->if exp) env))
         ((application? exp)
          (seck-apply (seck-eval (operator exp) env)
-                     (list-of-values (operand exp) env)))))
-
+                     (list-of-values (operand exp) env)))
+        (else
+          (error 'seck-eval "eval failed to recognize expression" exp))))
 
 ; @(tools)
 (define (tagged-list? exp tag)
@@ -321,6 +322,7 @@
 (define (operand exp) (cdr exp))
 (define (first-operand exps) (car exps))
 (define (rest-operands exps) (cdr exps))
+; fetch a list of values, eval them and return results as list
 (define (list-of-values exps env)
   (if (null? exps)
     '()

From f9b1b268585425663eedbef1958238bee10f8c2a Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 14:44:16 +0800
Subject: [PATCH 42/75] c4 2

---
 src/eval/c4_2.scm | 4 ++++
 1 file changed, 4 insertions(+)
 create mode 100644 src/eval/c4_2.scm

diff --git a/src/eval/c4_2.scm b/src/eval/c4_2.scm
new file mode 100644
index 0000000..d950e75
--- /dev/null
+++ b/src/eval/c4_2.scm
@@ -0,0 +1,4 @@
+; a) of course not. The precedence of match rule for application? is small
+; compared to assignment. So every pair will be matched by application
+;
+; b) wtf. This question is really weird.

From 0a8a5a927964581cfc99ac3a422b2aa2fba55984 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 15:24:50 +0800
Subject: [PATCH 43/75] c4 3

---
 src/eval/c4_3.scm | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)
 create mode 100644 src/eval/c4_3.scm

diff --git a/src/eval/c4_3.scm b/src/eval/c4_3.scm
new file mode 100644
index 0000000..fab1485
--- /dev/null
+++ b/src/eval/c4_3.scm
@@ -0,0 +1,18 @@
+; just like this style
+(define (init-operation-table)
+  (put 'quote text-of-quotation)
+  (put 'set! eval-assignment)
+  (put 'if eval-if)
+  ...
+  )
+
+(define (seck-eval exp env)
+  (cond ((self-evaluating? exp) exp)
+        ((variable? exp) (lookup-variable-value exp env))
+        (else
+          (let ((op (get (car exp))))
+            (cond (op (op exp env))
+                  ((application? exp)
+                   ...)
+                  (else
+                    (error ...)))))))

From 41586e6f38d27e44c112e53ae7db1ac97da99151 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 17:08:36 +0800
Subject: [PATCH 44/75] change #t to true to fix bug for cond->if

---
 src/eval/eval.scm | 61 ++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 55 insertions(+), 6 deletions(-)

diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 15505ec..cd54a98 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -1,5 +1,25 @@
 (load "./utils/dict.scm")
 
+(define (assert v)
+  (if (not v)
+    (error 'assert "failed")))
+
+(define (typeof v)
+  (cond ((boolean? v)
+         'boolean)
+        ((number? v)
+         'number)
+        ((string? v)
+         'string)
+        ((symbol? v)
+         'symbol)
+        ((null? v)
+         'null)
+        ((pair? v)
+         'pair)
+        (else
+          'unknown)))
+
 (define (seck-eval exp env)
   (cond ((self-evaluating? exp) exp)
         ((variable? exp) (lookup-variable-value exp env))
@@ -14,6 +34,8 @@
         ((begin? exp)
          (eval-sequence (begin-actions exp) env))
         ((cond? exp) (seck-eval (cond->if exp) env))
+        ((and? exp) (seck-eval (and->if exp) env))
+        ((or? exp) (seck-eval (or->if exp) env))
         ((application? exp)
          (seck-apply (seck-eval (operator exp) env)
                      (list-of-values (operand exp) env)))
@@ -142,6 +164,7 @@
         (list '/ /)
         (list '> >)
         (list '< <)
+        (list '= =)
         ))
 
 (define (primitive-procedure-names)
@@ -156,8 +179,8 @@
   (cadr proc))
 
 (define primitive-vars
-  (list (list '#t #t)
-        (list '#f #f)
+  (list (list 'true #t)
+        (list 'false #f)
         ))
 
 (define (primitive-var-names)
@@ -245,7 +268,7 @@
 
 (define (make-if predicate consequent . args)
   (if (null? args)
-    (list 'if predicate consequent '#f)
+    (list 'if predicate consequent 'false)
     (list 'if predicate consequent (car args))))
 
 (define (if? exp)
@@ -260,7 +283,7 @@
 (define (if-alternative exp)
   (if (not (null? (cdddr exp)))
     (cadddr exp)
-    '#f))
+    'false))
 
 (define (eval-if exp env)
   (if (seck-eval (if-predicate exp) env)
@@ -289,18 +312,43 @@
 (define (cond->if exp)
   (define (expand matches)
     (if (null? matches)
-      '#f
+      'false
       (let ((first (cond-firstmatch matches))
             (rest (cond-restmatches matches)))
         (if (cond-elsematch? first)
           (if (null? rest)
-            (make-if #t (sequence->exp (cond-match-actions first)))
+            (make-if 'true (sequence->exp (cond-match-actions first)))
             (error 'cond "else is not last match"))
           (make-if (cond-match-predicate first)
                    (sequence->exp (cond-match-actions first))
                    (expand rest))))))
   (expand (cdr exp)))
 
+; @(and/or)
+(define (and? exp)
+  (tagged-list? exp 'and))
+
+(define (or? exp)
+  (tagged-list? exp 'or))
+
+(define (and->if exp)
+  (define (expand exps)
+    (if (null? exps)
+      (make-if 'true 'true)
+      (make-if (car exps)
+               (expand (cdr exps))
+               'true)))
+  (expand (cdr exp)))
+
+(define (or->if exp)
+  (define (expand exps)
+    (if (null? exps)
+      (make-if 'true 'false)
+      (make-if (car exps)
+               'true
+               (expand (cdr exps)))))
+  (expand (cdr exp)))
+
 ; @(lambda)
 
 (define (lambda? exp)
@@ -358,6 +406,7 @@
     (seck-eval '(define a 3) new-env)
     (seck-eval '(set! a 4) new-env)
     (assert (= (seck-eval 'a new-env) 4))
+    ; (assert (seck-eval '(and (= a 4) (< a 5) (> a 2)) new-env))
     (seck-eval '(define (op a b)
                   (if (> a b)
                     (- a b)

From 2a70681ed06dbfaec1b0fbcfff371632021c4347 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 17:08:46 +0800
Subject: [PATCH 45/75] c4 4

---
 src/eval/c4_4.scm | 13 +++++++++++++
 1 file changed, 13 insertions(+)
 create mode 100644 src/eval/c4_4.scm

diff --git a/src/eval/c4_4.scm b/src/eval/c4_4.scm
new file mode 100644
index 0000000..c791e98
--- /dev/null
+++ b/src/eval/c4_4.scm
@@ -0,0 +1,13 @@
+
+; and as special forms
+; the same goes for or
+(define (eval-and exp env)
+  (define (iter exps)
+    (cond ((null? exp) #t)
+          ((not (seck-eval (car exp) env)) #f)
+          (else
+            (iter (cdr exp) env))))
+  (iter (cdr exp)))
+
+
+; see and/or as derived expressions in eval.scm

From ddb1e63f9edb783d028dd2379044e98b400e93fc Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 17:09:51 +0800
Subject: [PATCH 46/75] test for c4 4

---
 src/eval/eval.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index cd54a98..8f7de80 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -406,7 +406,8 @@
     (seck-eval '(define a 3) new-env)
     (seck-eval '(set! a 4) new-env)
     (assert (= (seck-eval 'a new-env) 4))
-    ; (assert (seck-eval '(and (= a 4) (< a 5) (> a 2)) new-env))
+    (assert (seck-eval '(and (= a 4) (< a 5) (> a 2)) new-env))
+    (assert (seck-eval '(or (= a 5) (> a 5) (> a 2)) new-env))
     (seck-eval '(define (op a b)
                   (if (> a b)
                     (- a b)

From 4a02752ffb666786dc4f3730f6747c902ca2e1a2 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 17:36:10 +0800
Subject: [PATCH 47/75] c4 5

---
 src/eval/c4_5.scm |  1 +
 src/eval/eval.scm | 28 ++++++++++++++++++++--------
 2 files changed, 21 insertions(+), 8 deletions(-)
 create mode 100644 src/eval/c4_5.scm

diff --git a/src/eval/c4_5.scm b/src/eval/c4_5.scm
new file mode 100644
index 0000000..eee52bf
--- /dev/null
+++ b/src/eval/c4_5.scm
@@ -0,0 +1 @@
+; in eval.scm
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 8f7de80..d174eb0 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -60,7 +60,7 @@
         (let ((found (car ret))
               (value (cadr ret)))
           (cond (found value)
-                ((null? (base-env))
+                ((empty-env? (base-env))
                  (error 'lookup "variable not defined" var))
                 (else
                   (((base-env) 'lookup) var))))))
@@ -104,6 +104,8 @@
   ((env 'insert) var value))
 
 (define the-empty-env '())
+(define (empty-env? env)
+  (null? env))
 
 ; @(expression)
 
@@ -130,6 +132,14 @@
         (else
           (make-begin seq))))
 
+(define (sequence->exp-2 predicate actions)
+  (if (eq? (car actions) '=>)
+    ; transforms to '(cadr (= a 3)) if predicate is (= a 3)
+    ; Note predicate will evaluated twice in the conditions!
+    (list (cadr actions)
+          predicate)  
+    (sequence->exp actions)))
+
 (define (make-begin seq)
   (cons 'begin seq))
 
@@ -315,13 +325,15 @@
       'false
       (let ((first (cond-firstmatch matches))
             (rest (cond-restmatches matches)))
-        (if (cond-elsematch? first)
-          (if (null? rest)
-            (make-if 'true (sequence->exp (cond-match-actions first)))
-            (error 'cond "else is not last match"))
-          (make-if (cond-match-predicate first)
-                   (sequence->exp (cond-match-actions first))
-                   (expand rest))))))
+        (cond ((cond-elsematch? first) ;else
+               (if (null? rest)
+                 (make-if 'true (sequence->exp (cond-match-actions first)))
+                 (error 'cond "else is not last match")))
+              (else ; the other conditions
+               (make-if (cond-match-predicate first)
+                        (sequence->exp-2 (cond-match-predicate first)
+                                         (cond-match-actions first))
+                        (expand rest)))))))
   (expand (cdr exp)))
 
 ; @(and/or)

From 4423e42f88991653c2e50f4c726606d484bf57b3 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 19:33:53 +0800
Subject: [PATCH 48/75] c4 6

---
 src/eval/c4_6.scm |  1 +
 src/eval/eval.scm | 18 ++++++++++++++++++
 2 files changed, 19 insertions(+)
 create mode 100644 src/eval/c4_6.scm

diff --git a/src/eval/c4_6.scm b/src/eval/c4_6.scm
new file mode 100644
index 0000000..eee52bf
--- /dev/null
+++ b/src/eval/c4_6.scm
@@ -0,0 +1 @@
+; in eval.scm
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index d174eb0..df084c3 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -36,6 +36,7 @@
         ((cond? exp) (seck-eval (cond->if exp) env))
         ((and? exp) (seck-eval (and->if exp) env))
         ((or? exp) (seck-eval (or->if exp) env))
+        ((let? exp) (seck-eval (let->combination exp) env))
         ((application? exp)
          (seck-apply (seck-eval (operator exp) env)
                      (list-of-values (operand exp) env)))
@@ -375,6 +376,18 @@
 (define (lambda-body exp)
   (cddr exp))
 
+; @(let)
+(define (let? exp)
+  (tagged-list? exp 'let))
+
+(define (let->combination exp)
+  (let ((var-bindings (cadr exp))
+        (body (cddr exp)))
+    (let ((vars (map car var-bindings))
+          (values (map cadr var-bindings)))
+      (cons (cons 'lambda
+                  (cons vars body))
+            values))))
 
 ; @(application)
 (define application? pair?)
@@ -437,4 +450,9 @@
                     1))
     (assert (equal? (seck-eval '(op2 2 2) new-env)
                     4))
+    (assert (equal? (seck-eval '(let ((a 3)
+                                      (b 4))
+                                  (cons a b))
+                               new-env)
+                    (cons 3 4)))
     ))

From 3bfbddcc952a91221b4b541cb394fa4970952425 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Thu, 26 Sep 2013 20:57:59 +0800
Subject: [PATCH 49/75] 4_7 unfinished

---
 src/eval/c4_7.scm |  1 +
 src/eval/eval.scm | 88 +++++++++++++++++++++++++++++++++++++----------
 2 files changed, 71 insertions(+), 18 deletions(-)
 create mode 100644 src/eval/c4_7.scm

diff --git a/src/eval/c4_7.scm b/src/eval/c4_7.scm
new file mode 100644
index 0000000..eee52bf
--- /dev/null
+++ b/src/eval/c4_7.scm
@@ -0,0 +1 @@
+; in eval.scm
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index df084c3..4024bdd 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -1,8 +1,14 @@
 (load "./utils/dict.scm")
 
-(define (assert v)
-  (if (not v)
-    (error 'assert "failed")))
+(define (assert exp)
+  (if (not exp)
+    (error 'assert "expression is not true")
+    exp))
+
+(define (assert-eq a b eqproc)
+  (if (not (eqproc a b))
+    (error 'assert-eq a " and " b " is not equal")
+    #t))
 
 (define (typeof v)
   (cond ((boolean? v)
@@ -37,6 +43,7 @@
         ((and? exp) (seck-eval (and->if exp) env))
         ((or? exp) (seck-eval (or->if exp) env))
         ((let? exp) (seck-eval (let->combination exp) env))
+        ((letstar? exp) (seck-eval (let*->nested-let exp) env))
         ((application? exp)
          (seck-apply (seck-eval (operator exp) env)
                      (list-of-values (operand exp) env)))
@@ -236,7 +243,7 @@
 (define (eval-sequence exps env)
   (if (last-exp? exps)
     (seck-eval (first-exp exps) env)
-    (eval-sequence (rest-exps) env)))
+    (eval-sequence (rest-exps exps) env)))
 
 ; @(assignment)
 
@@ -331,10 +338,10 @@
                  (make-if 'true (sequence->exp (cond-match-actions first)))
                  (error 'cond "else is not last match")))
               (else ; the other conditions
-               (make-if (cond-match-predicate first)
-                        (sequence->exp-2 (cond-match-predicate first)
-                                         (cond-match-actions first))
-                        (expand rest)))))))
+                (make-if (cond-match-predicate first)
+                         (sequence->exp-2 (cond-match-predicate first)
+                                          (cond-match-actions first))
+                         (expand rest)))))))
   (expand (cdr exp)))
 
 ; @(and/or)
@@ -380,14 +387,42 @@
 (define (let? exp)
   (tagged-list? exp 'let))
 
+(define (let-bindings exp) (cadr exp))
+(define (let-body exp) (cddr exp))
+(define (let-vars exp) (map car (let-bindings exp)))
+; if you define let-values here, there will be 
+(define (let-vals exp) (map cadr (let-bindings exp)))
+
 (define (let->combination exp)
-  (let ((var-bindings (cadr exp))
-        (body (cddr exp)))
-    (let ((vars (map car var-bindings))
-          (values (map cadr var-bindings)))
-      (cons (cons 'lambda
-                  (cons vars body))
-            values))))
+  (make-let (let-vars exp)
+            (let-vals exp) ; todo
+            (let-body exp)))
+
+(define (make-let vars values body)
+  (cons (cons 'lambda
+              (cons vars body))
+        values))
+
+(define (letstar? exp)
+  (tagged-list? exp 'let*))
+
+(define (let*->nested-let exp)
+  (define (wrap-let-body vars values)
+    (cond ((and (null? vars)
+                (null? values))
+           (make-let vars values (let-body exp)))
+          ((or (null? vars)
+               (null? values))
+           (error 'wrap-let-body "let vars-values length not match"))
+          (else
+            (make-let (list (car vars))
+                      (list (car values))
+                      (wrap-let-body (cdr vars)
+                                     (cdr values))))
+          ))
+  (wrap-let-body (let-vars exp)
+                 (let-vals exp)  ; todo
+                 ))
 
 ; @(application)
 (define application? pair?)
@@ -424,12 +459,16 @@
 
 (define global-env (setup-environment))
 
-(define (test-eval)
-  (assert (= (seck-eval '(+ 1 2) global-env) 3))
-  (assert (equal? (seck-eval '(cons 1 2) global-env) (cons 1 2)))
+(define (init-test-env)
   (let ((new-env (make-env global-env)))
     (seck-eval '(define a 3) new-env)
     (seck-eval '(set! a 4) new-env)
+    new-env))
+
+(define (test-eval)
+  (let ((new-env (init-test-env)))
+    (assert (= (seck-eval '(+ 1 2) global-env) 3))
+    (assert (equal? (seck-eval '(cons 1 2) global-env) (cons 1 2)))
     (assert (= (seck-eval 'a new-env) 4))
     (assert (seck-eval '(and (= a 4) (< a 5) (> a 2)) new-env))
     (assert (seck-eval '(or (= a 5) (> a 5) (> a 2)) new-env))
@@ -455,4 +494,17 @@
                                   (cons a b))
                                new-env)
                     (cons 3 4)))
+    (display (let*->nested-let '(let* ((x 1)
+                                       (y (+ x 1))
+                                       (z (+ x a))
+                                       )
+                                  (+ x y z))))(newline)
+    (assert-eq (seck-eval '(let* ((x 1)
+                                  (y (+ x 1))
+                                  (z (+ x a))
+                                  )
+                             (+ x y z))
+                          new-env)
+               8
+               =)
     ))

From ed189042d3fbd41f3846f089ca3208a6fc1e6e9a Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 27 Sep 2013 10:56:02 +0800
Subject: [PATCH 50/75] c4_7 updatE

---
 src/eval/c4_7.scm |  2 ++
 src/eval/eval.scm | 42 +++++++++++++++++++++---------------------
 2 files changed, 23 insertions(+), 21 deletions(-)

diff --git a/src/eval/c4_7.scm b/src/eval/c4_7.scm
index eee52bf..23039f1 100644
--- a/src/eval/c4_7.scm
+++ b/src/eval/c4_7.scm
@@ -1 +1,3 @@
 ; in eval.scm
+;
+;not need to expand let* in terms of non-derived expressions
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 4024bdd..53d5713 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -183,6 +183,7 @@
         (list '> >)
         (list '< <)
         (list '= =)
+        (list 'print print)
         ))
 
 (define (primitive-procedure-names)
@@ -394,15 +395,20 @@
 (define (let-vals exp) (map cadr (let-bindings exp)))
 
 (define (let->combination exp)
-  (make-let (let-vars exp)
-            (let-vals exp) ; todo
-            (let-body exp)))
+  (let->lambda (let-vars exp)
+               (let-vals exp) ; todo
+               (let-body exp)))
 
-(define (make-let vars values body)
+(define (let->lambda vars values body)
   (cons (cons 'lambda
               (cons vars body))
         values))
 
+(define (make-let var-bindings body)
+  (cons 'let
+        (cons var-bindings
+              body)))
+
 (define (letstar? exp)
   (tagged-list? exp 'let*))
 
@@ -410,15 +416,15 @@
   (define (wrap-let-body vars values)
     (cond ((and (null? vars)
                 (null? values))
-           (make-let vars values (let-body exp)))
+           (make-let '() (let-body exp)))
           ((or (null? vars)
                (null? values))
            (error 'wrap-let-body "let vars-values length not match"))
           (else
-            (make-let (list (car vars))
-                      (list (car values))
-                      (wrap-let-body (cdr vars)
-                                     (cdr values))))
+            (make-let (list (list (car vars)
+                                  (car values)))
+                      (list (wrap-let-body (cdr vars)
+                                           (cdr values)))))
           ))
   (wrap-let-body (let-vars exp)
                  (let-vals exp)  ; todo
@@ -494,17 +500,11 @@
                                   (cons a b))
                                new-env)
                     (cons 3 4)))
-    (display (let*->nested-let '(let* ((x 1)
-                                       (y (+ x 1))
-                                       (z (+ x a))
+    (assert (equal? (seck-eval '(let* ((x 1)
+                                       (y (+ x a))
+                                       (z (+ x y))
                                        )
-                                  (+ x y z))))(newline)
-    (assert-eq (seck-eval '(let* ((x 1)
-                                  (y (+ x 1))
-                                  (z (+ x a))
-                                  )
-                             (+ x y z))
-                          new-env)
-               8
-               =)
+                                  (+ x y z))
+                               new-env)
+                    12))
     ))

From 6709dd1ac5bf7e8b702efc594667145f924f72e7 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 27 Sep 2013 20:36:54 +0800
Subject: [PATCH 51/75] move library

---
 src/eval/c4_7.scm                          |  2 +-
 src/eval/eval.scm                          | 83 +++++++++++++++++-----
 src/eval/utils/dict.scm                    | 12 ++++
 src/lib/{ => r6rs}/base.scm                |  0
 src/lib/{ => r6rs}/coercion.scm            |  0
 src/lib/{ => r6rs}/complex-polar.scm       |  0
 src/lib/{ => r6rs}/complex-rectangular.scm |  0
 src/lib/{ => r6rs}/complex.scm             |  0
 src/lib/{ => r6rs}/concurrency.scm         |  0
 src/lib/{ => r6rs}/constraint.scm          |  0
 src/lib/{ => r6rs}/deriv.scm               |  0
 src/lib/{ => r6rs}/dict.scm                |  0
 src/lib/{ => r6rs}/functional.scm          |  0
 src/lib/{ => r6rs}/generic-arithmetic.scm  |  3 +-
 src/lib/{ => r6rs}/init.scm                |  0
 src/lib/{ => r6rs}/poly-terms.scm          |  0
 src/lib/{ => r6rs}/prime.scm               |  0
 src/lib/{ => r6rs}/queue.scm               |  3 +-
 src/lib/{ => r6rs}/rand.scm                |  0
 src/lib/{ => r6rs}/series.scm              |  0
 src/lib/{ => r6rs}/stream.scm              |  0
 src/lib/{ => r6rs}/symbolic-algebra.scm    |  0
 src/lib/{ => r6rs}/table2d.scm             |  0
 src/lib/{ => r6rs}/utils.scm               |  0
 src/run-test.sh                            |  2 +-
 25 files changed, 84 insertions(+), 21 deletions(-)
 rename src/lib/{ => r6rs}/base.scm (100%)
 rename src/lib/{ => r6rs}/coercion.scm (100%)
 rename src/lib/{ => r6rs}/complex-polar.scm (100%)
 rename src/lib/{ => r6rs}/complex-rectangular.scm (100%)
 rename src/lib/{ => r6rs}/complex.scm (100%)
 rename src/lib/{ => r6rs}/concurrency.scm (100%)
 rename src/lib/{ => r6rs}/constraint.scm (100%)
 rename src/lib/{ => r6rs}/deriv.scm (100%)
 rename src/lib/{ => r6rs}/dict.scm (100%)
 rename src/lib/{ => r6rs}/functional.scm (100%)
 rename src/lib/{ => r6rs}/generic-arithmetic.scm (99%)
 rename src/lib/{ => r6rs}/init.scm (100%)
 rename src/lib/{ => r6rs}/poly-terms.scm (100%)
 rename src/lib/{ => r6rs}/prime.scm (100%)
 rename src/lib/{ => r6rs}/queue.scm (96%)
 rename src/lib/{ => r6rs}/rand.scm (100%)
 rename src/lib/{ => r6rs}/series.scm (100%)
 rename src/lib/{ => r6rs}/stream.scm (100%)
 rename src/lib/{ => r6rs}/symbolic-algebra.scm (100%)
 rename src/lib/{ => r6rs}/table2d.scm (100%)
 rename src/lib/{ => r6rs}/utils.scm (100%)

diff --git a/src/eval/c4_7.scm b/src/eval/c4_7.scm
index 23039f1..bc26535 100644
--- a/src/eval/c4_7.scm
+++ b/src/eval/c4_7.scm
@@ -1,3 +1,3 @@
 ; in eval.scm
 ;
-;not need to expand let* in terms of non-derived expressions
+; no need to expand let* in terms of non-derived expressions
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 53d5713..bd63c32 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -1,9 +1,5 @@
 (load "./utils/dict.scm")
-
-(define (assert exp)
-  (if (not exp)
-    (error 'assert "expression is not true")
-    exp))
+(load "utils/guile.scm")
 
 (define (assert-eq a b eqproc)
   (if (not (eqproc a b))
@@ -99,7 +95,7 @@
              new-env)
             ((or (null? vars)
                  (null? values))
-             (error 'extend-environment "vars and values should have equal lenght"))
+             (error 'extend-environment "procedure arguments not match"))
             (else
               ((new-env 'insert) (car vars) (car values))
               (iter (cdr vars) (cdr values)))))
@@ -242,9 +238,14 @@
   (cadddr proc))
 
 (define (eval-sequence exps env)
-  (if (last-exp? exps)
-    (seck-eval (first-exp exps) env)
-    (eval-sequence (rest-exps exps) env)))
+  (cond ((null? exps)
+         (error 'eval-sequence "no expression in code in block"))
+        (( last-exp? exps)
+         (seck-eval (first-exp exps) env))
+        (else
+          (seck-eval (first-exp exps) env)
+          (eval-sequence (rest-exps exps) env))
+        ))
 
 ; @(assignment)
 
@@ -264,6 +265,8 @@
 
 ; @(defintion)
 
+(define (make-definition name value)
+  (list 'define name value))
 (define (definition? exp)
   (tagged-list? exp 'define))
 
@@ -388,20 +391,39 @@
 (define (let? exp)
   (tagged-list? exp 'let))
 
-(define (let-bindings exp) (cadr exp))
-(define (let-body exp) (cddr exp))
+(define (let-bindings exp)
+  (if (namedlet? exp)
+    (caddr exp)
+    (cadr exp)
+    ))
+
+(define (let-body exp)
+  (if (namedlet? exp)
+    (cdddr exp)
+    (cddr exp)
+    ))
 (define (let-vars exp) (map car (let-bindings exp)))
 ; if you define let-values here, there will be 
 (define (let-vals exp) (map cadr (let-bindings exp)))
+(define (namedlet? exp) (symbol? (cadr exp)))
+(define (let->name exp) (cadr exp))
 
 (define (let->combination exp)
-  (let->lambda (let-vars exp)
-               (let-vals exp) ; todo
-               (let-body exp)))
+  (if (namedlet? exp)
+    (cons (make-lambda '()
+                       (list (make-definition (let->name exp)
+                                              (make-lambda (let-vars exp)
+                                                           (let-body exp)))
+                             (cons (let->name exp)
+                                   (let-vals exp))
+                             ))
+          '())
+    (let->lambda (let-vars exp)
+                 (let-vals exp)
+                 (let-body exp))))
 
 (define (let->lambda vars values body)
-  (cons (cons 'lambda
-              (cons vars body))
+  (cons (make-lambda vars body)
         values))
 
 (define (make-let var-bindings body)
@@ -471,6 +493,16 @@
     (seck-eval '(set! a 4) new-env)
     new-env))
 
+(define test-let-exp '(let ((x 1)
+                            (y 2))
+                        (+ x y)))
+(define test-named-let-exp '(let fib-iter ((a 1)
+                                           (b 0)
+                                           (count 10))
+                              (if (= count 0)
+                                b
+                                (fib-iter (+ a b) a (- count 1)))))
+
 (define (test-eval)
   (let ((new-env (init-test-env)))
     (assert (= (seck-eval '(+ 1 2) global-env) 3))
@@ -507,4 +539,21 @@
                                   (+ x y z))
                                new-env)
                     12))
-    ))
+    (assert (equal? (seck-eval '(let fib-iter ((a 1)
+                                               (b 0)
+                                               (count 10))
+                                  (if (= count 0)
+                                    b
+                                    (fib-iter (+ a b)
+                                              a
+                                              (- count 1))))
+                               new-env)
+                    55))
+    )
+    (seck-eval '((lambda ()
+                   (define (foo a) a)
+                   (foo 3)
+                   )
+                 )
+               global-env)
+    'pass)
diff --git a/src/eval/utils/dict.scm b/src/eval/utils/dict.scm
index 55b230b..561ad45 100644
--- a/src/eval/utils/dict.scm
+++ b/src/eval/utils/dict.scm
@@ -76,3 +76,15 @@
 
 (define (dict-set! d key value)
   ((d 'set) key value))
+
+(define (dict-keys d)
+  ((d 'keys)))
+
+(define (dict-display-keys d keys)
+  (if (not (null? keys))
+    (begin
+      (display (car keys))(display "-")(display (dict-lookup d (car keys)))(newline)
+      (dict-display-keys d (cdr keys)))))
+
+(define (dict-display d)
+  (dict-display-keys d (dict-keys d)))
diff --git a/src/lib/base.scm b/src/lib/r6rs/base.scm
similarity index 100%
rename from src/lib/base.scm
rename to src/lib/r6rs/base.scm
diff --git a/src/lib/coercion.scm b/src/lib/r6rs/coercion.scm
similarity index 100%
rename from src/lib/coercion.scm
rename to src/lib/r6rs/coercion.scm
diff --git a/src/lib/complex-polar.scm b/src/lib/r6rs/complex-polar.scm
similarity index 100%
rename from src/lib/complex-polar.scm
rename to src/lib/r6rs/complex-polar.scm
diff --git a/src/lib/complex-rectangular.scm b/src/lib/r6rs/complex-rectangular.scm
similarity index 100%
rename from src/lib/complex-rectangular.scm
rename to src/lib/r6rs/complex-rectangular.scm
diff --git a/src/lib/complex.scm b/src/lib/r6rs/complex.scm
similarity index 100%
rename from src/lib/complex.scm
rename to src/lib/r6rs/complex.scm
diff --git a/src/lib/concurrency.scm b/src/lib/r6rs/concurrency.scm
similarity index 100%
rename from src/lib/concurrency.scm
rename to src/lib/r6rs/concurrency.scm
diff --git a/src/lib/constraint.scm b/src/lib/r6rs/constraint.scm
similarity index 100%
rename from src/lib/constraint.scm
rename to src/lib/r6rs/constraint.scm
diff --git a/src/lib/deriv.scm b/src/lib/r6rs/deriv.scm
similarity index 100%
rename from src/lib/deriv.scm
rename to src/lib/r6rs/deriv.scm
diff --git a/src/lib/dict.scm b/src/lib/r6rs/dict.scm
similarity index 100%
rename from src/lib/dict.scm
rename to src/lib/r6rs/dict.scm
diff --git a/src/lib/functional.scm b/src/lib/r6rs/functional.scm
similarity index 100%
rename from src/lib/functional.scm
rename to src/lib/r6rs/functional.scm
diff --git a/src/lib/generic-arithmetic.scm b/src/lib/r6rs/generic-arithmetic.scm
similarity index 99%
rename from src/lib/generic-arithmetic.scm
rename to src/lib/r6rs/generic-arithmetic.scm
index 82f4dbd..17775b7 100644
--- a/src/lib/generic-arithmetic.scm
+++ b/src/lib/r6rs/generic-arithmetic.scm
@@ -12,7 +12,8 @@
           make-complex-from-mag-ang
           )
 
-  (import (chezscheme)
+  (import (rnrs)
+          (rnrs mutable-pairs)
           (base)
           (complex)
           (functional)
diff --git a/src/lib/init.scm b/src/lib/r6rs/init.scm
similarity index 100%
rename from src/lib/init.scm
rename to src/lib/r6rs/init.scm
diff --git a/src/lib/poly-terms.scm b/src/lib/r6rs/poly-terms.scm
similarity index 100%
rename from src/lib/poly-terms.scm
rename to src/lib/r6rs/poly-terms.scm
diff --git a/src/lib/prime.scm b/src/lib/r6rs/prime.scm
similarity index 100%
rename from src/lib/prime.scm
rename to src/lib/r6rs/prime.scm
diff --git a/src/lib/queue.scm b/src/lib/r6rs/queue.scm
similarity index 96%
rename from src/lib/queue.scm
rename to src/lib/r6rs/queue.scm
index 058890f..db7c4fe 100644
--- a/src/lib/queue.scm
+++ b/src/lib/r6rs/queue.scm
@@ -6,7 +6,8 @@
           delete-queue!
           front-queue
           beautiful-display-queue)
-  (import (chezscheme))
+  (import (rnrs)
+          (rnrs mutable-pairs))
 
   (define (make-queue) (cons '() '()))
   (define (front-ptr q) (car q))
diff --git a/src/lib/rand.scm b/src/lib/r6rs/rand.scm
similarity index 100%
rename from src/lib/rand.scm
rename to src/lib/r6rs/rand.scm
diff --git a/src/lib/series.scm b/src/lib/r6rs/series.scm
similarity index 100%
rename from src/lib/series.scm
rename to src/lib/r6rs/series.scm
diff --git a/src/lib/stream.scm b/src/lib/r6rs/stream.scm
similarity index 100%
rename from src/lib/stream.scm
rename to src/lib/r6rs/stream.scm
diff --git a/src/lib/symbolic-algebra.scm b/src/lib/r6rs/symbolic-algebra.scm
similarity index 100%
rename from src/lib/symbolic-algebra.scm
rename to src/lib/r6rs/symbolic-algebra.scm
diff --git a/src/lib/table2d.scm b/src/lib/r6rs/table2d.scm
similarity index 100%
rename from src/lib/table2d.scm
rename to src/lib/r6rs/table2d.scm
diff --git a/src/lib/utils.scm b/src/lib/r6rs/utils.scm
similarity index 100%
rename from src/lib/utils.scm
rename to src/lib/r6rs/utils.scm
diff --git a/src/run-test.sh b/src/run-test.sh
index c99cd75..7a3ac38 100755
--- a/src/run-test.sh
+++ b/src/run-test.sh
@@ -6,4 +6,4 @@ then
 fi
 #petite --libdirs lib --script $filename
 
-csi -q -I lib -s $filename
+csi -q -I lib/r6rs -s $filename

From 2fd4e024692c5c53cdb562cabf7f19234edcb3d1 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 27 Sep 2013 20:37:07 +0800
Subject: [PATCH 52/75] c4 8;

---
 src/eval/c4_8.scm        |  1 +
 src/eval/utils/guile.scm | 18 ++++++++++++++++++
 2 files changed, 19 insertions(+)
 create mode 100644 src/eval/c4_8.scm
 create mode 100644 src/eval/utils/guile.scm

diff --git a/src/eval/c4_8.scm b/src/eval/c4_8.scm
new file mode 100644
index 0000000..eee52bf
--- /dev/null
+++ b/src/eval/c4_8.scm
@@ -0,0 +1 @@
+; in eval.scm
diff --git a/src/eval/utils/guile.scm b/src/eval/utils/guile.scm
new file mode 100644
index 0000000..a4b890b
--- /dev/null
+++ b/src/eval/utils/guile.scm
@@ -0,0 +1,18 @@
+(define (assert exp)
+  (if (not exp)
+    (error 'assert "expression is not true")
+    exp)
+  )
+
+(define (print . args)
+  (define (iter args)
+    (if (not (null? args))
+      (begin
+        (display (car args))(display " ")
+        (iter (cdr args))
+        )))
+  (iter args))
+
+(define (println . args)
+  (print args)(newline)
+  )

From 59a1f181c4a4cc21546809ddb7ea6ae66b48b6f0 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Fri, 27 Sep 2013 21:19:48 +0800
Subject: [PATCH 53/75] c4 9 - 12

---
 src/eval/c4_10.scm           |  2 ++
 src/eval/c4_11.scm           |  1 +
 src/eval/c4_12.scm           |  1 +
 src/eval/c4_9_unfinished.scm |  2 ++
 src/eval/demo.scm            | 23 +++++++++++++++++++++++
 src/eval/eval.scm            | 11 +++++++++++
 6 files changed, 40 insertions(+)
 create mode 100644 src/eval/c4_10.scm
 create mode 100644 src/eval/c4_11.scm
 create mode 100644 src/eval/c4_12.scm
 create mode 100644 src/eval/c4_9_unfinished.scm
 create mode 100644 src/eval/demo.scm

diff --git a/src/eval/c4_10.scm b/src/eval/c4_10.scm
new file mode 100644
index 0000000..09a0272
--- /dev/null
+++ b/src/eval/c4_10.scm
@@ -0,0 +1,2 @@
+; this can be achieved by modifying the variable?, begin? func ...
+; and corresponding make func
diff --git a/src/eval/c4_11.scm b/src/eval/c4_11.scm
new file mode 100644
index 0000000..eee52bf
--- /dev/null
+++ b/src/eval/c4_11.scm
@@ -0,0 +1 @@
+; in eval.scm
diff --git a/src/eval/c4_12.scm b/src/eval/c4_12.scm
new file mode 100644
index 0000000..834dfa6
--- /dev/null
+++ b/src/eval/c4_12.scm
@@ -0,0 +1 @@
+; wtf
diff --git a/src/eval/c4_9_unfinished.scm b/src/eval/c4_9_unfinished.scm
new file mode 100644
index 0000000..3ec2571
--- /dev/null
+++ b/src/eval/c4_9_unfinished.scm
@@ -0,0 +1,2 @@
+; in eval.scm
+;
diff --git a/src/eval/demo.scm b/src/eval/demo.scm
new file mode 100644
index 0000000..7b12efb
--- /dev/null
+++ b/src/eval/demo.scm
@@ -0,0 +1,23 @@
+(define (fib n)
+  (display (let fib-iter ((a 1)
+                 (b 0)
+                 (count n))
+    (if (= count 0)
+      b
+      (fib-iter (+ a b) a (- count 1))))
+           )
+  (display fib-iter)
+  )
+
+
+((lambda ()
+   (define fib-iter
+     (lambda (a b count)
+       (if (= count 0)
+         b
+         (fib-iter (+ a b) a (- count 1))
+         )
+       ))
+   (fib-iter 1 0 10)
+   )
+ )
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index bd63c32..3497fb0 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -40,6 +40,7 @@
         ((or? exp) (seck-eval (or->if exp) env))
         ((let? exp) (seck-eval (let->combination exp) env))
         ((letstar? exp) (seck-eval (let*->nested-let exp) env))
+        ((for? exp) (seck-eval (for->let exp) env))
         ((application? exp)
          (seck-apply (seck-eval (operator exp) env)
                      (list-of-values (operand exp) env)))
@@ -452,6 +453,16 @@
                  (let-vals exp)  ; todo
                  ))
 
+; @(for)
+
+(define (for? exp)
+  (tagged-list? exp 'for))
+(define (for-init exp) (cadr exp))
+(define (for-can-continue exp) (caddr exp))
+(define (for-step exp) (cadddr exp))
+(define (for-body exp) (cddddr exp))
+
+
 ; @(application)
 (define application? pair?)
 (define (operator exp) (car exp))

From 316c20f7e91a62c5bc7f2ff0741c097af9aca53f Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sat, 28 Sep 2013 00:27:27 +0800
Subject: [PATCH 54/75] c4 13

---
 src/eval/c4_13.scm | 8 ++++++++
 1 file changed, 8 insertions(+)
 create mode 100644 src/eval/c4_13.scm

diff --git a/src/eval/c4_13.scm b/src/eval/c4_13.scm
new file mode 100644
index 0000000..60b54bc
--- /dev/null
+++ b/src/eval/c4_13.scm
@@ -0,0 +1,8 @@
+; 1. I don't think we really need `make-unbound`
+; 2. If we really need it, then it should be a terrible idea to
+; provide a feature that can remove the binding from enclosed environment.
+; Since that may bring ugly code. For example, if we call a func wrote by
+; others, and the func may remove some binding silently, which will cause
+; hard to debug bugs. Another case is, if the program provides some interface
+; that can insert code by others, than the malicious users can call the unbound
+; feature to bring down the whole system.

From 08a4ad8d1b9fcf65d834174879fffda0aa3d5911 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sat, 28 Sep 2013 01:05:23 +0800
Subject: [PATCH 55/75] c4 14

---
 src/eval/c4_14.scm            | 19 +++++++++++++++++++
 src/eval/eval.scm             | 18 ++++++++++++++----
 src/eval/utils/functional.scm |  1 +
 src/eval/utils/guile.scm      |  2 +-
 4 files changed, 35 insertions(+), 5 deletions(-)
 create mode 100644 src/eval/c4_14.scm
 create mode 100644 src/eval/utils/functional.scm

diff --git a/src/eval/c4_14.scm b/src/eval/c4_14.scm
new file mode 100644
index 0000000..efc6708
--- /dev/null
+++ b/src/eval/c4_14.scm
@@ -0,0 +1,19 @@
+; assume map as: (map proc list-of-args)
+; if map is made as builtin, when evaluating map, we
+; have the primitive map, but when we evaluate the primitive
+; map, we are actuallly interpret it in the interpretor environment,
+; and in this environment, proc is not defined.
+;
+; Therefore, builtin is not allowed to take procedure as arguments.
+;
+; Note, when we eval map, we should make sure list-of-args is really 
+; a list for the interpretor. Below is a demo
+;
+(load "eval.scm")
+(define (simple-test)
+  (seck-eval '(define (foo x)
+                x)
+             global-env)
+  (display (seck-eval '(map foo '(1 2 3))  ; make sure (1 2 3) is quoted
+                      global-env))
+  )
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 3497fb0..c0d7d3a 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -1,5 +1,6 @@
 (load "./utils/dict.scm")
-(load "utils/guile.scm")
+(load "./utils/functional.scm")
+(load "./utils/guile.scm")
 
 (define (assert-eq a b eqproc)
   (if (not (eqproc a b))
@@ -181,6 +182,7 @@
         (list '< <)
         (list '= =)
         (list 'print print)
+        (list 'map map)
         ))
 
 (define (primitive-procedure-names)
@@ -219,7 +221,7 @@
   (tagged-list? proc 'primitive))
 
 (define (apply-primitive-procedure proc args)
-  (apply proc args))
+  (apply (primitive-proc-impl proc) args))
 
 ; @(procedures)
 
@@ -477,7 +479,7 @@
           (list-of-values (rest-operands exps) env))))
 (define (seck-apply procedure arguments)
   (cond ((primitive-procedure? procedure)
-         (apply-primitive-procedure (primitive-proc-impl procedure) arguments))
+         (apply-primitive-procedure procedure arguments))
         ((compound-procedure? procedure)
          (eval-sequence
            (procedure-body procedure)
@@ -488,7 +490,7 @@
         (else
           (error
             'seck-apply
-            "Inknown procedure type" procedure))))
+            "Unknown procedure type" procedure))))
 
 ; @(global env)
 (define (setup-environment)
@@ -568,3 +570,11 @@
                  )
                global-env)
     'pass)
+
+(define (simple-test)
+  (seck-eval '(define (foo x)
+                x)
+             global-env)
+  (display (seck-eval '(map foo '(1 2 3))
+                      global-env))
+  )
diff --git a/src/eval/utils/functional.scm b/src/eval/utils/functional.scm
new file mode 100644
index 0000000..a8e7fde
--- /dev/null
+++ b/src/eval/utils/functional.scm
@@ -0,0 +1 @@
+(define (same x) x)
diff --git a/src/eval/utils/guile.scm b/src/eval/utils/guile.scm
index a4b890b..b3a517e 100644
--- a/src/eval/utils/guile.scm
+++ b/src/eval/utils/guile.scm
@@ -14,5 +14,5 @@
   (iter args))
 
 (define (println . args)
-  (print args)(newline)
+  (apply print args)(newline)
   )

From 3fe7b9e166999d45ade96b75359899dc9e07f7ee Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sat, 28 Sep 2013 17:55:29 +0800
Subject: [PATCH 56/75] c4 15

---
 src/eval/c4_15.scm | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 src/eval/c4_15.scm

diff --git a/src/eval/c4_15.scm b/src/eval/c4_15.scm
new file mode 100644
index 0000000..698188c
--- /dev/null
+++ b/src/eval/c4_15.scm
@@ -0,0 +1 @@
+; http://blog.csdn.net/zzljlu/article/details/7625514

From 2386ac7b9255d9ecd4130d57c223eec940b66f48 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sat, 28 Sep 2013 23:17:03 +0800
Subject: [PATCH 57/75] scoping test for eval

---
 src/eval/eval.scm | 79 ++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 64 insertions(+), 15 deletions(-)

diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index c0d7d3a..a696686 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -30,7 +30,7 @@
         ((assignment? exp) (eval-assignment exp env))
         ((definition? exp) (eval-definition exp env))
         ((if? exp) (eval-if exp env))
-        ((lambda? exp)
+        ((lambda? exp) ; evaluated when define procedure
          (make-procedure (lambda-params exp)
                          (lambda-body exp)
                          env))
@@ -43,6 +43,7 @@
         ((letstar? exp) (seck-eval (let*->nested-let exp) env))
         ((for? exp) (seck-eval (for->let exp) env))
         ((application? exp)
+         ; evaluated when call procedure
          (seck-apply (seck-eval (operator exp) env)
                      (list-of-values (operand exp) env)))
         (else
@@ -54,6 +55,9 @@
     (eq? (car exp) tag)
     #f))
 
+(define (unassigned? value)
+  (eq? value '*unassigned*))
+
 ; @(environment)
 
 (define (make-env base)
@@ -65,7 +69,11 @@
       (let ((ret (dict-lookup (cur-env-var-dict) var)))
         (let ((found (car ret))
               (value (cadr ret)))
-          (cond (found value)
+          (cond ((and found
+                      (not (unassigned? value)))
+                 value)
+                (found
+                  (error 'lookup "variabled looked up is unassigned"))
                 ((empty-env? (base-env))
                  (error 'lookup "variable not defined" var))
                 (else
@@ -249,6 +257,21 @@
           (seck-eval (first-exp exps) env)
           (eval-sequence (rest-exps exps) env))
         ))
+; proc-body is a sequence of expressions to be evaluated
+(define (scan-out-defines proc-body)
+  (let ((definitions (filter definition? proc-body))
+        (non-definitions (filter (compose not definition?)
+                                 proc-body)))
+    (make-let (map (lambda (exp)
+                     (list (definition-var exp)
+                           '*unassigned*))
+                   definitions)
+              (append (map (lambda (exp)
+                             (list 'set!
+                                   (definition-var exp)
+                                   (definition-value exp)))
+                           definitions)
+                      non-definitions))))
 
 ; @(assignment)
 
@@ -465,6 +488,7 @@
 (define (for-body exp) (cddddr exp))
 
 
+
 ; @(application)
 (define application? pair?)
 (define (operator exp) (car exp))
@@ -486,12 +510,20 @@
            (extend-environment
              (procedure-parameters procedure)
              arguments
+             ; Here, we eval the expression in
+             ; a new env which extends procedure env(the
+             ; env in which procedure is defined). This 
+             ; ensures lexical scoping.
+             ; If we evaluate the procedure bodyin
+             ; the env that seck-apply is called, then
+             ; it will be dynamic scoping.
              (procedure-env procedure))))
         (else
           (error
             'seck-apply
             "Unknown procedure type" procedure))))
 
+
 ; @(global env)
 (define (setup-environment)
   (extend-environment (primitive-names)
@@ -563,18 +595,35 @@
                                new-env)
                     55))
     )
-    (seck-eval '((lambda ()
-                   (define (foo a) a)
-                   (foo 3)
-                   )
+  (seck-eval '((lambda ()
+                 (define (foo a) a)
+                 (foo 3)
                  )
-               global-env)
-    'pass)
-
-(define (simple-test)
-  (seck-eval '(define (foo x)
-                x)
+               )
              global-env)
-  (display (seck-eval '(map foo '(1 2 3))
-                      global-env))
-  )
+  'pass)
+
+(define proc (make-procedure '(c)
+                             '((define b (+ a x))
+                               (define a 5)
+                               (+ a b c))
+                             global-env))
+(define (test-scan-out-definitons)
+  (scan-out-defines (procedure-body proc)))
+
+(define (test-scoping)
+  ; if it's lexical scoping, it will return 7
+  ; but if it's dynamic scoping, it will return 8
+  (let ((new-env (make-env global-env)))
+    (seck-eval '(define a 4)
+               new-env)
+    (seck-eval '(define (foo)
+                  (+ a 3))
+               new-env)
+    (seck-eval '(define (bar)
+                  (define a 5)
+                  (foo))
+               new-env)
+    (println (seck-eval '(bar)
+                        new-env))
+    ))

From 36c8e2dbda0fb07731af3d90f5570b8977617bb2 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sat, 28 Sep 2013 23:22:50 +0800
Subject: [PATCH 58/75] c4 16

---
 src/eval/c4_16.scm | 7 +++++++
 1 file changed, 7 insertions(+)
 create mode 100644 src/eval/c4_16.scm

diff --git a/src/eval/c4_16.scm b/src/eval/c4_16.scm
new file mode 100644
index 0000000..bc66376
--- /dev/null
+++ b/src/eval/c4_16.scm
@@ -0,0 +1,7 @@
+; a) in eval.scm
+; b) in eval.scm
+; c) if put in make-procedure, than scan-out-defines
+; is evaluated when procedure defined. But when put
+; in procedure-body, scan-out-defines is evaluated when
+; procedure evaluated. It's just a matter of whether
+; we want the internal definition to be lazy.

From 64cf7c6dd5d91a22a0feeb61360e196c68fdf751 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sat, 28 Sep 2013 23:43:22 +0800
Subject: [PATCH 59/75] c4 16

---
 src/eval/c4_16.scm   |  3 +++
 src/eval/demo.scm    | 27 ++++---------------------
 src/eval/eval.scm    | 47 +++++++++++++++++++-------------------------
 src/eval/scoping.scm | 18 +++++++++++++++++
 4 files changed, 45 insertions(+), 50 deletions(-)
 create mode 100644 src/eval/scoping.scm

diff --git a/src/eval/c4_16.scm b/src/eval/c4_16.scm
index bc66376..10e846d 100644
--- a/src/eval/c4_16.scm
+++ b/src/eval/c4_16.scm
@@ -5,3 +5,6 @@
 ; in procedure-body, scan-out-defines is evaluated when
 ; procedure evaluated. It's just a matter of whether
 ; we want the internal definition to be lazy.
+; Note when implement scan-out-defines, to pass
+; a (quote symbol) to the evaluator, you have to
+; pass (quote (quote symbol)), see my explanation in eval.scm
diff --git a/src/eval/demo.scm b/src/eval/demo.scm
index 7b12efb..25e364b 100644
--- a/src/eval/demo.scm
+++ b/src/eval/demo.scm
@@ -1,23 +1,4 @@
-(define (fib n)
-  (display (let fib-iter ((a 1)
-                 (b 0)
-                 (count n))
-    (if (= count 0)
-      b
-      (fib-iter (+ a b) a (- count 1))))
-           )
-  (display fib-iter)
-  )
-
-
-((lambda ()
-   (define fib-iter
-     (lambda (a b count)
-       (if (= count 0)
-         b
-         (fib-iter (+ a b) a (- count 1))
-         )
-       ))
-   (fib-iter 1 0 10)
-   )
- )
+(let ((b *unassigned*) (a *unassigned*))
+   (set! b (+ a x))
+   (set! a 5)
+   (+ a b c))
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index a696686..badd972 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -237,7 +237,10 @@
   (tagged-list? proc 'procedure))
 
 (define (make-procedure params body-seq env)
-  (list 'procedure params body-seq env))
+  (list 'procedure
+        params
+        (scan-out-defines body-seq)
+        env))
 
 (define (procedure-parameters proc)
   (cadr proc))
@@ -262,16 +265,23 @@
   (let ((definitions (filter definition? proc-body))
         (non-definitions (filter (compose not definition?)
                                  proc-body)))
-    (make-let (map (lambda (exp)
-                     (list (definition-var exp)
-                           '*unassigned*))
-                   definitions)
-              (append (map (lambda (exp)
-                             (list 'set!
-                                   (definition-var exp)
-                                   (definition-value exp)))
+    (if (not (null? definitions))
+      (list (make-let (map (lambda (exp)
+                             (list (definition-var exp)
+                                   ;; Here, we use '', since
+                                   ;; we want to pass a (quote symbol) to the evaluator,
+                                   ;; but not a symbol to the evaluator. The outer quote
+                                   ;; will be used to protect (quote symbol) in
+                                   ;; the naive scheme evaluator.
+                                   ''*unassigned*))
                            definitions)
-                      non-definitions))))
+                      (append (map (lambda (exp)
+                                     (list 'set!
+                                           (definition-var exp)
+                                           (definition-value exp)))
+                                   definitions)
+                              non-definitions)))
+      proc-body)))
 
 ; @(assignment)
 
@@ -610,20 +620,3 @@
                              global-env))
 (define (test-scan-out-definitons)
   (scan-out-defines (procedure-body proc)))
-
-(define (test-scoping)
-  ; if it's lexical scoping, it will return 7
-  ; but if it's dynamic scoping, it will return 8
-  (let ((new-env (make-env global-env)))
-    (seck-eval '(define a 4)
-               new-env)
-    (seck-eval '(define (foo)
-                  (+ a 3))
-               new-env)
-    (seck-eval '(define (bar)
-                  (define a 5)
-                  (foo))
-               new-env)
-    (println (seck-eval '(bar)
-                        new-env))
-    ))
diff --git a/src/eval/scoping.scm b/src/eval/scoping.scm
new file mode 100644
index 0000000..9734c47
--- /dev/null
+++ b/src/eval/scoping.scm
@@ -0,0 +1,18 @@
+(load "eval.scm")
+
+(define (test-scoping)
+  ; if it's lexical scoping, it will return 7
+  ; but if it's dynamic scoping, it will return 8
+  (let ((new-env (make-env global-env)))
+    (seck-eval '(define a 4)
+               new-env)
+    (seck-eval '(define (foo)
+                  (+ a 3))
+               new-env)
+    (seck-eval '(define (bar)
+                  (define a 5)
+                  (foo))
+               new-env)
+    (println (seck-eval '(bar)
+                        new-env))
+    ))

From 61861f6eda46d4fa5fb5d15973aa911350a48e92 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 11:06:46 +0800
Subject: [PATCH 60/75] c4 17

---
 src/eval/c4_17.scm | 6 ++++++
 1 file changed, 6 insertions(+)
 create mode 100644 src/eval/c4_17.scm

diff --git a/src/eval/c4_17.scm b/src/eval/c4_17.scm
new file mode 100644
index 0000000..f5ef948
--- /dev/null
+++ b/src/eval/c4_17.scm
@@ -0,0 +1,6 @@
+; Another wtf question.
+; An extra frame is created since let is evaluated to lambda.
+; This question seems forgets an important assumption, that is,
+; the internal defintion may be interwined with other expressions.
+; In this case, what you need to do is just to reorder the internal
+; definitions, which will not cause extra frame construction.

From 590c2d09e41ffc1b52d576a9f27f5bc5791afad3 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 14:44:44 +0800
Subject: [PATCH 61/75] multiple scheme implementation support update

---
 src/eval/eval.scm            |  58 +++++++++++++++----
 src/lib/r6rs/chez.scm        | 106 +++++++++++++++++++++++++++++++++++
 src/lib/r6rs/concurrency.scm |  78 --------------------------
 src/lib/r6rs/rand.scm        |  18 ------
 src/lib/r6rs/utils.scm       |  15 ++---
 5 files changed, 158 insertions(+), 117 deletions(-)
 create mode 100644 src/lib/r6rs/chez.scm

diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index badd972..aa0a174 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -41,6 +41,7 @@
         ((or? exp) (seck-eval (or->if exp) env))
         ((let? exp) (seck-eval (let->combination exp) env))
         ((letstar? exp) (seck-eval (let*->nested-let exp) env))
+        ((letrec? exp) (seck-eval (letrec->let exp) env))
         ((for? exp) (seck-eval (for->let exp) env))
         ((application? exp)
          ; evaluated when call procedure
@@ -239,7 +240,7 @@
 (define (make-procedure params body-seq env)
   (list 'procedure
         params
-        (scan-out-defines body-seq)
+        (scan-out-defines body-seq #f)
         env))
 
 (define (procedure-parameters proc)
@@ -261,11 +262,12 @@
           (eval-sequence (rest-exps exps) env))
         ))
 ; proc-body is a sequence of expressions to be evaluated
-(define (scan-out-defines proc-body)
+(define (scan-out-defines proc-body do-scan-out)
   (let ((definitions (filter definition? proc-body))
         (non-definitions (filter (compose not definition?)
                                  proc-body)))
-    (if (not (null? definitions))
+    (if (and do-scan-out
+             (not (null? definitions)))
       (list (make-let (map (lambda (exp)
                              (list (definition-var exp)
                                    ;; Here, we use '', since
@@ -488,6 +490,20 @@
                  (let-vals exp)  ; todo
                  ))
 
+
+(define (letrec? exp)
+  (tagged-list? exp 'letrec))
+(define (letrec->let exp)
+  (make-let 
+    (map (lambda (var)
+           (list var ''*assigned*))
+         (let-vars exp))
+    (append (map (lambda (var value)
+                   (list 'set! var value))
+                 (let-vars exp)
+                 (let-vals exp))
+            (let-body exp))))
+
 ; @(for)
 
 (define (for? exp)
@@ -613,10 +629,32 @@
              global-env)
   'pass)
 
-(define proc (make-procedure '(c)
-                             '((define b (+ a x))
-                               (define a 5)
-                               (+ a b c))
-                             global-env))
-(define (test-scan-out-definitons)
-  (scan-out-defines (procedure-body proc)))
+
+(define letrec-exp '(letrec ((even?
+                               (lambda (n)
+                                 (if (= n 0)
+                                   true
+                                   (odd? (- n 1)))))
+                             (odd?
+                               (lambda (n)
+                                 (if (= n 0)
+                                   false
+                                   (even? (- n 1))))))
+                      (even? x)))
+
+(define (test-letrec)
+  (seck-eval '(define (f x)
+                (letrec ((even?
+                           (lambda (n)
+                             (if (= n 0)
+                               true
+                               (odd? (- n 1)))))
+                         (odd?
+                           (lambda (n)
+                             (if (= n 0)
+                               false
+                               (even? (- n 1))))))
+                  (even? x)))
+             global-env)
+  (seck-eval '(f 3) global-env)
+  )
diff --git a/src/lib/r6rs/chez.scm b/src/lib/r6rs/chez.scm
new file mode 100644
index 0000000..93c1437
--- /dev/null
+++ b/src/lib/r6rs/chez.scm
@@ -0,0 +1,106 @@
+(library
+  (chez)
+  (export sleepfor
+          parallel-execute
+          make-semaphore
+          semaphore-acquire
+          semaphore-release
+          rand
+          random-in-range
+          random-init
+          random-update
+          )
+  (import (chezscheme))
+
+  ; @(utils)
+  ; sleep for s seconds
+  (define (sleepfor s)
+    (sleep (make-time 'time-duration 0 s)))
+
+  ; @(concurrency)
+  (define (parallel-execute . args)
+    (for-each fork-thread args))
+
+  (define (make-serializer)
+    (let ((mutex (make-mutex)))
+      (lambda (p)
+        (define (serialized-p . args)
+          (mutex 'acquire)
+          (let ((val (apply p args)))
+            (mutex 'release)
+            val))
+        serialized-p)))
+  (define (make-semaphore n)
+    (let ((mutex (make-mutex)))
+      (define (acquire . args)
+        (let ((block? (if (null? args)
+                        #t
+                        (car args))))
+          ; Note n's if test should be protected by mutex.
+          (mutex-acquire mutex)
+          (if (> n 0)
+            (begin (set! n (- n 1))
+                   (mutex-release mutex)
+                   #t)
+            (begin (mutex-release mutex)
+                   (if block?
+                     (acquire)
+                     #f)))
+          ))
+      (define (release)
+        (mutex-acquire mutex)
+        (set! n (+ n 1))
+        (mutex-release mutex))
+
+      (define (self msg)
+        (cond ((eq? msg 'acquire) acquire)
+              ((eq? msg 'release) release)
+              (else
+                (error 'semaphore-self "UNKNOWN MESSAGE" msg))))
+      self))
+
+  (define (semaphore-acquire sem . args)
+    (apply (sem 'acquire) args))
+
+  (define (semaphore-release sem)
+    (sem 'release))
+
+  ; a not practical implementation of test-and-set!
+  (define (test-and-set! cell)
+    (if (car cell)
+      #t
+      (begin (set-car! cell #t)
+             #f)))
+
+  (define (clear! cell)
+    (set-car! cell #f))
+
+  (define (mutex-test-and-set-impl)
+    (define (make-mutex)
+      (let ((cell (list #f)))
+        (define (self msg)
+          (cond ((eq? msg 'acquire)
+                 (if (test-and-set! cell)
+                   (self 'acquire)
+                   #t))
+                ((eq? msg 'release)
+                 (clear! cell))))
+        self)))
+
+  ; [low high)
+  (define (random-in-range low high)
+    (let ((range (- high low)))
+      (+ low (random range))))
+  (define random-init (time-second (current-time)))
+  (define (random-update x)
+    (let ((a 40)
+          (b 2641)
+          (m 729))
+      (modulo (+ (* a x) b) m)))
+
+  (define rand
+    (let ((x random-init))
+      (lambda ()
+        (set! x (rand-update x))
+        x)))
+  )
diff --git a/src/lib/r6rs/concurrency.scm b/src/lib/r6rs/concurrency.scm
index 3867ad4..e69de29 100644
--- a/src/lib/r6rs/concurrency.scm
+++ b/src/lib/r6rs/concurrency.scm
@@ -1,78 +0,0 @@
-(library
-  (concurrency)
-  (export parallel-execute
-          make-semaphore
-          semaphore-acquire
-          semaphore-release)
-
-  (import (chezscheme))
-
-  (define (parallel-execute . args)
-    (for-each fork-thread args))
-
-  (define (make-serializer)
-    (let ((mutex (make-mutex)))
-      (lambda (p)
-        (define (serialized-p . args)
-          (mutex 'acquire)
-          (let ((val (apply p args)))
-            (mutex 'release)
-            val))
-        serialized-p)))
-  (define (make-semaphore n)
-    (let ((mutex (make-mutex)))
-      (define (acquire . args)
-        (let ((block? (if (null? args)
-                        #t
-                        (car args))))
-          ; Note n's if test should be protected by mutex.
-          (mutex-acquire mutex)
-          (if (> n 0)
-            (begin (set! n (- n 1))
-                   (mutex-release mutex)
-                   #t)
-            (begin (mutex-release mutex)
-                   (if block?
-                     (acquire)
-                     #f)))
-          ))
-      (define (release)
-        (mutex-acquire mutex)
-        (set! n (+ n 1))
-        (mutex-release mutex))
-
-      (define (self msg)
-        (cond ((eq? msg 'acquire) acquire)
-              ((eq? msg 'release) release)
-              (else
-                (error 'semaphore-self "UNKNOWN MESSAGE" msg))))
-      self))
-
-  (define (semaphore-acquire sem . args)
-    (apply (sem 'acquire) args))
-
-  (define (semaphore-release sem)
-    (sem 'release))
-
-  ; a not practical implementation of test-and-set!
-  (define (test-and-set! cell)
-    (if (car cell)
-      #t
-      (begin (set-car! cell #t)
-             #f)))
-
-  (define (clear! cell)
-    (set-car! cell #f))
-
-  (define (mutex-test-and-set-impl)
-    (define (make-mutex)
-      (let ((cell (list #f)))
-        (define (self msg)
-          (cond ((eq? msg 'acquire)
-                 (if (test-and-set! cell)
-                   (self 'acquire)
-                   #t))
-                ((eq? msg 'release)
-                 (clear! cell))))
-        self)))
-  )
diff --git a/src/lib/r6rs/rand.scm b/src/lib/r6rs/rand.scm
index cd381da..8b13789 100644
--- a/src/lib/r6rs/rand.scm
+++ b/src/lib/r6rs/rand.scm
@@ -1,19 +1 @@
-(library
-  (rand)
-  (import (chezscheme))
-  (export rand
-          random-init
-          random-update)
-  (define random-init (time-second (current-time)))
-  (define (random-update x)
-    (let ((a 40)
-          (b 2641)
-          (m 729))
-      (modulo (+ (* a x) b) m)))
 
-  (define rand
-    (let ((x random-init))
-      (lambda ()
-        (set! x (rand-update x))
-        x)))
-  )
diff --git a/src/lib/r6rs/utils.scm b/src/lib/r6rs/utils.scm
index cea583f..16f87fe 100644
--- a/src/lib/r6rs/utils.scm
+++ b/src/lib/r6rs/utils.scm
@@ -7,14 +7,15 @@
           set-caddr!
           inlist?
           range
-          random-in-range
-          sleepfor
           divides?
           divisible? 
           println
           average
           pythagorean-triple?)
-  (import (chezscheme))
+
+  (import (rnrs)
+          (rnrs r5rs)
+          (rnrs mutable-pairs))
   (define (set-cadr! lst v)
     (set-car! (cdr lst) v))
 
@@ -40,14 +41,6 @@
           ((> a b) (cons a (range (- a 1) b)))
           ((< a b) (cons a (range a (- b 1))))))
 
-  ; [low high)
-  (define (random-in-range low high)
-    (let ((range (- high low)))
-      (+ low (random range))))
-
-  ; sleep for s seconds
-  (define (sleepfor s)
-    (sleep (make-time 'time-duration 0 s)))
   (define (divides? a b)
     (= (remainder b a) 0))
 

From c32133b359ca183123553c1351375ee88afeb339 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 14:53:45 +0800
Subject: [PATCH 62/75] c4 18-21

---
 src/eval/c4_18.scm | 60 ++++++++++++++++++++++++++++++++++++++++++++++
 src/eval/c4_19.scm | 19 +++++++++++++++
 src/eval/c4_20.scm | 57 +++++++++++++++++++++++++++++++++++++++++++
 src/eval/c4_21.scm | 44 ++++++++++++++++++++++++++++++++++
 4 files changed, 180 insertions(+)
 create mode 100644 src/eval/c4_18.scm
 create mode 100644 src/eval/c4_19.scm
 create mode 100644 src/eval/c4_20.scm
 create mode 100644 src/eval/c4_21.scm

diff --git a/src/eval/c4_18.scm b/src/eval/c4_18.scm
new file mode 100644
index 0000000..1c75435
--- /dev/null
+++ b/src/eval/c4_18.scm
@@ -0,0 +1,60 @@
+; There is a series problem of the scanned out method shown in the exercise.
+(lambda ()
+  (let ((u '*unassigned*)
+        (v '*unassigned*))
+    ; Here, when some-expression is evaluated, if they contain circular dependance
+    ; like solve has, u/v may be evaluated, in which case an error reported.
+    (let ((a 'some-expression)
+          (b 'some-expression))
+      (set! u a)
+      (set! v b))
+    'expressions))
+
+
+; here shows the case
+
+(define (solve f y0 dt)
+  (define y (integral (delay dy) y0 dt))
+  (define dy (stream-map f y))
+  y)
+
+; ->
+
+(define solve
+  (lambda (f y0 dt)
+    (let ((y '*assigned*)
+          (dy '*assigned*))
+      (let ((a (integral (delay dy) y0 dt))
+            (b (stream-map f y)))
+        (set! y a)
+        (set! dy b)
+        y))))
+
+; ->
+(define solve
+  (lambda (f y0 dt)
+    ((lambda (y dy)
+       (let ((a (integral (delay dy) y0 dt))
+             (b (stream-map f y)))
+         (set! y a)
+         (set! dy b)
+         y))
+     '*assigned*
+     '*assigned*)))
+; ->
+(define solve
+  (lambda (f y0 dt)
+    ((lambda (y dy)
+       ((lambda (a b)
+          (set! y a)
+          (set! dy b)
+          y)
+        ; here, procedure args are evaluated, and error reported.
+        (integral (delay dy) y0 dt)
+        (stream-map f y))
+       '*assigned*
+       '*assigned*))
+    ))
+
+
+; apparently, there is no such problem for the one in the text
diff --git a/src/eval/c4_19.scm b/src/eval/c4_19.scm
new file mode 100644
index 0000000..c69c391
--- /dev/null
+++ b/src/eval/c4_19.scm
@@ -0,0 +1,19 @@
+(load "eval.scm")
+
+; to enable scan-out-defines, try to modify it in eval.scm
+
+(define (demo)
+  (seck-eval '(let ((a 1))
+                (define (f x)
+                  (define b (+ a x))
+                  (define a 5)
+                  (+ a b))
+                (f 10))
+             global-env)
+  )
+(let ((a 1))
+  (define (f x)
+    (define b (+ a x))
+    (define a 5)
+    (+ a b))
+  (f 10))
diff --git a/src/eval/c4_20.scm b/src/eval/c4_20.scm
new file mode 100644
index 0000000..d718902
--- /dev/null
+++ b/src/eval/c4_20.scm
@@ -0,0 +1,57 @@
+; a) in eval.scm
+; b) let's do some evaluation manually
+
+; for letrec
+
+(letrec ((even?
+           (lambda (n)
+             (if (= n 0)
+               true
+               (odd? (- n 1)))))
+         (odd?
+           (lambda (n)
+             (if (= n 0)
+               false
+               (even? (- n 1))))))
+  <exp>)
+
+; ->
+
+(let ((even? '*assigned*)
+      (odd? '*assigned*))
+  (set! even? ...)
+  (set! odd? ...)
+  <exp>)
+; ->
+((lambda (even? odd?)
+   (set! even? ...)
+   (set! odd? ...))
+ '*assigned*
+ '*assigned*
+ )
+
+; but for let
+
+(let ((even? ...)
+      (odd? ...))
+  (even? x))
+
+; ->
+
+((lambda (even? odd?)
+   (even? x))
+ ; here, when evaluating the following lambda procedure,
+ ; odd?, even? will be looked up in the lambda procedure environment(lexical scoping),
+ ; therefore, they will not be found.
+ (lambda (n)
+   (if (= n 0)
+     true
+     (odd? (- n 1))))
+ (lambda (n)
+   (if (= n 0)
+     false
+     (even? (- n 1))))
+)
+
+; so, the internal diff between letrec and let is, letrec keeps the environment
+; for argument in the let body.
diff --git a/src/eval/c4_21.scm b/src/eval/c4_21.scm
new file mode 100644
index 0000000..faa6589
--- /dev/null
+++ b/src/eval/c4_21.scm
@@ -0,0 +1,44 @@
+(load "eval.scm")
+
+(define fact-exp '((lambda (n)
+                     ((lambda (fact)
+                        (fact fact n))
+                      (lambda (ft k)
+                        (if (= k 1)
+                          1
+                          (* k (ft ft (- k 1)))))))
+                   10))
+
+; a)
+; (println (seck-eval fact-exp global-env))
+
+
+(define fib-exp '((lambda (n)
+                    ((lambda (fib)
+                       (fib fib 0 1 0)
+                       )
+                     (lambda (fib a b k)
+                       (if (= k n)
+                         b
+                         (fib fib b (+ a b) (+ 1 k))))
+                     ))
+                  10))
+
+; (println (seck-eval fib-exp global-env))
+
+; b)
+
+(define f-exp '(define (f x)
+                 ((lambda (even? odd?)
+                    (even? even? odd? x))
+                  (lambda (ev? od? n)
+                    (if (= n 0)
+                      true
+                      (od? ev? od? (- n 1))))
+                  (lambda (ev? od? n)
+                    (if (= n 0)
+                      false
+                      (ev? ev? od? (- n 1)))))))
+
+(seck-eval f-exp global-env)
+(println (seck-eval '(f 4) global-env))

From 44f7da033956342a2865f03c10597e98b09148ef Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 15:36:25 +0800
Subject: [PATCH 63/75] more efficient eval update

---
 src/eval/eval-base.scm |  0
 src/eval/eval1.scm     | 28 ++++++++++++++++++++++++++++
 2 files changed, 28 insertions(+)
 create mode 100644 src/eval/eval-base.scm
 create mode 100644 src/eval/eval1.scm

diff --git a/src/eval/eval-base.scm b/src/eval/eval-base.scm
new file mode 100644
index 0000000..e69de29
diff --git a/src/eval/eval1.scm b/src/eval/eval1.scm
new file mode 100644
index 0000000..42f8f28
--- /dev/null
+++ b/src/eval/eval1.scm
@@ -0,0 +1,28 @@
+; a more efficient eval
+
+(define (seck-eval exp env)
+  ((analyze exp) env))
+
+(define (analyze exp)
+  (cond ((self-evaluating? exp)
+         (analyze-self-evaluating exp))
+        ((quoted? exp) (analyze-quoted exp))
+        ((variable? exp) (analyze-variable exp))
+        ((assignment? exp) (analyze-assignment exp))
+        ((definition? exp) (analyze-definition exp))
+        ((if? exp) (analyze-if exp))
+        ((lambda? exp) (analyze-lambda exp))
+        ((begin? exp) (analyze-sequence (begin-actions exp)))
+        ((cond? exp) (analyze (cond->if exp)))
+        ((application? exp) (analyze-application exp))
+        (else
+          (error 'analyze "unknown expression type" exp))))
+
+(define (analyze-self-evaluating exp)
+  (lambda (env) exp))
+
+(define (analyze-quoted exp)
+  (let ((qval (text-of-quotation exp)))
+    (lambda (env) qval)))
+
+(define (analyze-quoted exp)

From 4d2ab8edc85d7ac04af5e104115bd26f3c767a9e Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 17:32:05 +0800
Subject: [PATCH 64/75] eval analyze update

---
 src/eval/eval-base.scm | 456 +++++++++++++++++++++++++++++++++++
 src/eval/eval.scm      | 531 ++++-------------------------------------
 src/eval/eval1.scm     |  88 +++++++
 3 files changed, 586 insertions(+), 489 deletions(-)

diff --git a/src/eval/eval-base.scm b/src/eval/eval-base.scm
index e69de29..b4d28bf 100644
--- a/src/eval/eval-base.scm
+++ b/src/eval/eval-base.scm
@@ -0,0 +1,456 @@
+(define (assert-eq a b eqproc)
+  (if (not (eqproc a b))
+    (error 'assert-eq a " and " b " is not equal")
+    #t))
+
+(define (typeof v)
+  (cond ((boolean? v)
+         'boolean)
+        ((number? v)
+         'number)
+        ((string? v)
+         'string)
+        ((symbol? v)
+         'symbol)
+        ((null? v)
+         'null)
+        ((pair? v)
+         'pair)
+        (else
+          'unknown)))
+
+; @(tools)
+(define (tagged-list? exp tag)
+  (if (pair? exp)
+    (eq? (car exp) tag)
+    #f))
+
+(define (unassigned? value)
+  (eq? value '*unassigned*))
+
+; @(environment)
+
+(define (make-env base)
+  (let ((local-env (list (make-dict) base)))
+    (define (cur-env-var-dict) (car local-env))
+    (define (base-env) (cadr local-env))
+
+    (define (lookup var)
+      (let ((ret (dict-lookup (cur-env-var-dict) var)))
+        (let ((found (car ret))
+              (value (cadr ret)))
+          (cond ((and found
+                      (not (unassigned? value)))
+                 value)
+                (found
+                  (error 'lookup "variabled looked up is unassigned"))
+                ((empty-env? (base-env))
+                 (error 'lookup "variable not defined" var))
+                (else
+                  (((base-env) 'lookup) var))))))
+
+    (define (insert! var value)
+      (dict-insert! (cur-env-var-dict) var value))
+
+    (define (set! var value)
+      (if (dict-set! (cur-env-var-dict) var value)
+        value
+        (error 'set! "setting an unbound value for " var)))
+
+    (define (dispatch action)
+      (cond ((eq? action 'lookup) lookup)
+            ((eq? action 'insert) insert!)
+            (else
+              (error 'make-env-dispatch "unknown action" action))))
+    dispatch))
+
+(define (lookup-variable-value var env)
+  ((env 'lookup) var))
+
+(define (extend-environment vars values base-env)
+  (let ((new-env (make-env base-env)))
+    (define (iter vars values)
+      (cond ((and (null? vars)
+                  (null? values))
+             new-env)
+            ((or (null? vars)
+                 (null? values))
+             (error 'extend-environment "procedure arguments not match"))
+            (else
+              ((new-env 'insert) (car vars) (car values))
+              (iter (cdr vars) (cdr values)))))
+    (iter vars values)))
+
+(define (define-variable! var value env)
+  ((env 'insert) var value))
+
+(define (set-variable-value! var value env)
+  ((env 'insert) var value))
+
+(define the-empty-env '())
+(define (empty-env? env)
+  (null? env))
+
+; @(expression)
+
+(define (first-exp exps)
+  (car exps))
+
+(define (rest-exps exps)
+  (cdr exps))
+
+(define (last-exp? exps)
+  (and (pair? exps)
+       (null? (cdr exps))))
+
+(define (begin? exp)
+  (tagged-list? exp 'begin))
+
+(define (begin-actions exp)
+  (cdr exp))
+
+; implicit begin
+(define (sequence->exp seq)
+  (cond ((null? seq) seq)
+        ((last-exp? seq) (first-exp seq))
+        (else
+          (make-begin seq))))
+
+(define (sequence->exp-2 predicate actions)
+  (if (eq? (car actions) '=>)
+    ; transforms to '(cadr (= a 3)) if predicate is (= a 3)
+    ; Note predicate will evaluated twice in the conditions!
+    (list (cadr actions)
+          predicate)  
+    (sequence->exp actions)))
+
+(define (make-begin seq)
+  (cons 'begin seq))
+
+; @(self-evaluating)
+(define (self-evaluating? exp)
+  (cond ((number? exp) #t)
+        ((string? exp) #t)
+        (else #f)))
+
+(define (variable? exp)
+  (symbol? exp))
+
+
+; @(quote)
+
+(define (quoted? exp)
+  (tagged-list? exp 'quote))
+
+(define (text-of-quotation exp)
+  (cadr exp))
+
+; @(primitives)
+
+(define primitive-procedures
+  (list (list 'car car)
+        (list 'cdr cdr)
+        (list 'cons cons)
+        (list 'null? null?)
+        (list '+ +)
+        (list '- -)
+        (list '* *)
+        (list '/ /)
+        (list '> >)
+        (list '< <)
+        (list '= =)
+        (list 'print print)
+        (list 'map map)
+        ))
+
+(define (primitive-procedure-names)
+  (map car
+       primitive-procedures))
+
+(define (primitive-procedure-objects)
+  (map (lambda (proc) (list 'primitive (cadr proc)))
+       primitive-procedures))
+
+(define (primitive-proc-impl proc)
+  (cadr proc))
+
+(define primitive-vars
+  (list (list 'true #t)
+        (list 'false #f)
+        ))
+
+(define (primitive-var-names)
+  (map car
+       primitive-vars))
+
+(define (primitive-var-values)
+  (map cadr
+       primitive-vars))
+
+(define (primitive-names)
+  (append (primitive-procedure-names)
+          (primitive-var-names)))
+
+(define (primitive-values)
+  (append (primitive-procedure-objects)
+          (primitive-var-values)))
+
+(define (primitive-procedure? proc)
+  (tagged-list? proc 'primitive))
+
+(define (apply-primitive-procedure proc args)
+  (apply (primitive-proc-impl proc) args))
+
+; @(procedures)
+
+(define (compound-procedure? proc)
+  (tagged-list? proc 'procedure))
+
+(define (make-procedure params body-seq env)
+  (list 'procedure
+        params
+        body-seq
+        env))
+
+(define (procedure-parameters proc)
+  (cadr proc))
+
+(define (procedure-body proc)
+  (caddr proc))
+
+(define (procedure-env proc)
+  (cadddr proc))
+
+; @(assignment)
+
+(define (assignment? exp)
+  (tagged-list? exp 'set!))
+
+(define (assignment-var exp)
+  (cadr exp))
+
+(define (assignment-value exp)
+  (caddr exp))
+
+
+; @(defintion)
+
+(define (make-definition name value)
+  (list 'define name value))
+(define (definition? exp)
+  (tagged-list? exp 'define))
+
+(define (definition-var exp)
+  (if (symbol? (cadr exp))
+    (cadr exp)
+    (caadr exp)))
+
+(define (definition-value exp)
+  (if (symbol? (cadr exp))
+    (caddr exp)
+    (make-lambda (cdadr exp)
+                 (cddr exp))))
+
+
+; @(if)
+
+(define (make-if predicate consequent . args)
+  (if (null? args)
+    (list 'if predicate consequent 'false)
+    (list 'if predicate consequent (car args))))
+
+(define (if? exp)
+  (tagged-list? exp 'if))
+
+(define (if-predicate exp)
+  (cadr exp))
+
+(define (if-consequent exp)
+  (caddr exp))
+
+(define (if-alternative exp)
+  (if (not (null? (cdddr exp)))
+    (cadddr exp)
+    'false))
+
+
+
+; @(cond)
+(define (cond? exp)
+  (tagged-list? exp 'cond))
+
+(define (cond-firstmatch matches)
+  (car matches))
+(define (cond-restmatches matches)
+  (cdr matches))
+(define (cond-lastmatch matches)
+  (null? (cdr matches)))
+(define (cond-elsematch? match)
+  (eq? (car match) 'else))
+
+(define (cond-match-predicate match)
+  (car match))
+
+(define (cond-match-actions match)
+  (cdr match))
+
+(define (cond->if exp)
+  (define (expand matches)
+    (if (null? matches)
+      'false
+      (let ((first (cond-firstmatch matches))
+            (rest (cond-restmatches matches)))
+        (cond ((cond-elsematch? first) ;else
+               (if (null? rest)
+                 (make-if 'true (sequence->exp (cond-match-actions first)))
+                 (error 'cond "else is not last match")))
+              (else ; the other conditions
+                (make-if (cond-match-predicate first)
+                         (sequence->exp-2 (cond-match-predicate first)
+                                          (cond-match-actions first))
+                         (expand rest)))))))
+  (expand (cdr exp)))
+
+; @(and/or)
+(define (and? exp)
+  (tagged-list? exp 'and))
+
+(define (or? exp)
+  (tagged-list? exp 'or))
+
+(define (and->if exp)
+  (define (expand exps)
+    (if (null? exps)
+      (make-if 'true 'true)
+      (make-if (car exps)
+               (expand (cdr exps))
+               'true)))
+  (expand (cdr exp)))
+
+(define (or->if exp)
+  (define (expand exps)
+    (if (null? exps)
+      (make-if 'true 'false)
+      (make-if (car exps)
+               'true
+               (expand (cdr exps)))))
+  (expand (cdr exp)))
+
+; @(lambda)
+
+(define (lambda? exp)
+  (tagged-list? exp 'lambda))
+
+(define (make-lambda params body-seq)
+  (cons 'lambda (cons params body-seq)))
+
+(define (lambda-params exp)
+  (cadr exp))
+
+(define (lambda-body exp)
+  (cddr exp))
+
+; @(let)
+(define (let? exp)
+  (tagged-list? exp 'let))
+
+(define (let-bindings exp)
+  (if (namedlet? exp)
+    (caddr exp)
+    (cadr exp)
+    ))
+
+(define (let-body exp)
+  (if (namedlet? exp)
+    (cdddr exp)
+    (cddr exp)
+    ))
+(define (let-vars exp) (map car (let-bindings exp)))
+; if you define let-values here, there will be 
+(define (let-vals exp) (map cadr (let-bindings exp)))
+(define (namedlet? exp) (symbol? (cadr exp)))
+(define (let->name exp) (cadr exp))
+
+(define (let->combination exp)
+  (if (namedlet? exp)
+    (cons (make-lambda '()
+                       (list (make-definition (let->name exp)
+                                              (make-lambda (let-vars exp)
+                                                           (let-body exp)))
+                             (cons (let->name exp)
+                                   (let-vals exp))
+                             ))
+          '())
+    (let->lambda (let-vars exp)
+                 (let-vals exp)
+                 (let-body exp))))
+
+(define (let->lambda vars values body)
+  (cons (make-lambda vars body)
+        values))
+
+(define (make-let var-bindings body)
+  (cons 'let
+        (cons var-bindings
+              body)))
+
+(define (letstar? exp)
+  (tagged-list? exp 'let*))
+
+(define (let*->nested-let exp)
+  (define (wrap-let-body vars values)
+    (cond ((and (null? vars)
+                (null? values))
+           (make-let '() (let-body exp)))
+          ((or (null? vars)
+               (null? values))
+           (error 'wrap-let-body "let vars-values length not match"))
+          (else
+            (make-let (list (list (car vars)
+                                  (car values)))
+                      (list (wrap-let-body (cdr vars)
+                                           (cdr values)))))
+          ))
+  (wrap-let-body (let-vars exp)
+                 (let-vals exp)  ; todo
+                 ))
+
+
+(define (letrec? exp)
+  (tagged-list? exp 'letrec))
+(define (letrec->let exp)
+  (make-let 
+    (map (lambda (var)
+           (list var ''*assigned*))
+         (let-vars exp))
+    (append (map (lambda (var value)
+                   (list 'set! var value))
+                 (let-vars exp)
+                 (let-vals exp))
+            (let-body exp))))
+
+; @(for)
+
+(define (for? exp)
+  (tagged-list? exp 'for))
+(define (for-init exp) (cadr exp))
+(define (for-can-continue exp) (caddr exp))
+(define (for-step exp) (cadddr exp))
+(define (for-body exp) (cddddr exp))
+
+
+
+; @(application)
+(define application? pair?)
+(define (operator exp) (car exp))
+(define (operand exp) (cdr exp))
+(define (first-operand exps) (car exps))
+(define (rest-operands exps) (cdr exps))
+
+; @(global env)
+(define (setup-environment)
+  (extend-environment (primitive-names)
+                      (primitive-values)
+                      the-empty-env))
+
+(define global-env (setup-environment))
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index aa0a174..6b629e8 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -1,27 +1,7 @@
 (load "./utils/dict.scm")
 (load "./utils/functional.scm")
 (load "./utils/guile.scm")
-
-(define (assert-eq a b eqproc)
-  (if (not (eqproc a b))
-    (error 'assert-eq a " and " b " is not equal")
-    #t))
-
-(define (typeof v)
-  (cond ((boolean? v)
-         'boolean)
-        ((number? v)
-         'number)
-        ((string? v)
-         'string)
-        ((symbol? v)
-         'symbol)
-        ((null? v)
-         'null)
-        ((pair? v)
-         'pair)
-        (else
-          'unknown)))
+(load "eval-base.scm")
 
 (define (seck-eval exp env)
   (cond ((self-evaluating? exp) exp)
@@ -50,207 +30,53 @@
         (else
           (error 'seck-eval "eval failed to recognize expression" exp))))
 
-; @(tools)
-(define (tagged-list? exp tag)
-  (if (pair? exp)
-    (eq? (car exp) tag)
-    #f))
-
-(define (unassigned? value)
-  (eq? value '*unassigned*))
-
-; @(environment)
-
-(define (make-env base)
-  (let ((local-env (list (make-dict) base)))
-    (define (cur-env-var-dict) (car local-env))
-    (define (base-env) (cadr local-env))
-
-    (define (lookup var)
-      (let ((ret (dict-lookup (cur-env-var-dict) var)))
-        (let ((found (car ret))
-              (value (cadr ret)))
-          (cond ((and found
-                      (not (unassigned? value)))
-                 value)
-                (found
-                  (error 'lookup "variabled looked up is unassigned"))
-                ((empty-env? (base-env))
-                 (error 'lookup "variable not defined" var))
-                (else
-                  (((base-env) 'lookup) var))))))
-
-    (define (insert! var value)
-      (dict-insert! (cur-env-var-dict) var value))
-
-    (define (set! var value)
-      (if (dict-set! (cur-env-var-dict) var value)
-        value
-        (error 'set! "setting an unbound value for " var)))
-
-    (define (dispatch action)
-      (cond ((eq? action 'lookup) lookup)
-            ((eq? action 'insert) insert!)
-            (else
-              (error 'make-env-dispatch "unknown action" action))))
-    dispatch))
-
-(define (lookup-variable-value var env)
-  ((env 'lookup) var))
-
-(define (extend-environment vars values base-env)
-  (let ((new-env (make-env base-env)))
-    (define (iter vars values)
-      (cond ((and (null? vars)
-                  (null? values))
-             new-env)
-            ((or (null? vars)
-                 (null? values))
-             (error 'extend-environment "procedure arguments not match"))
-            (else
-              ((new-env 'insert) (car vars) (car values))
-              (iter (cdr vars) (cdr values)))))
-    (iter vars values)))
-
-(define (define-variable! var value env)
-  ((env 'insert) var value))
-
-(define (set-variable-value! var value env)
-  ((env 'insert) var value))
-
-(define the-empty-env '())
-(define (empty-env? env)
-  (null? env))
-
-; @(expression)
-
-(define (first-exp exps)
-  (car exps))
-
-(define (rest-exps exps)
-  (cdr exps))
-
-(define (last-exp? exps)
-  (and (pair? exps)
-       (null? (cdr exps))))
-
-(define (begin? exp)
-  (tagged-list? exp 'begin))
-
-(define (begin-actions exp)
-  (cdr exp))
-
-; implicit begin
-(define (sequence->exp seq)
-  (cond ((null? seq) seq)
-        ((last-exp? seq) (first-exp seq))
-        (else
-          (make-begin seq))))
-
-(define (sequence->exp-2 predicate actions)
-  (if (eq? (car actions) '=>)
-    ; transforms to '(cadr (= a 3)) if predicate is (= a 3)
-    ; Note predicate will evaluated twice in the conditions!
-    (list (cadr actions)
-          predicate)  
-    (sequence->exp actions)))
-
-(define (make-begin seq)
-  (cons 'begin seq))
-
-; @(self-evaluating)
-(define (self-evaluating? exp)
-  (cond ((number? exp) #t)
-        ((string? exp) #t)
-        (else #f)))
-
-(define (variable? exp)
-  (symbol? exp))
-
-
-; @(quote)
-
-(define (quoted? exp)
-  (tagged-list? exp 'quote))
-
-(define (text-of-quotation exp)
-  (cadr exp))
-
-; @(primitives)
-
-(define primitive-procedures
-  (list (list 'car car)
-        (list 'cdr cdr)
-        (list 'cons cons)
-        (list 'null? null?)
-        (list '+ +)
-        (list '- -)
-        (list '* *)
-        (list '/ /)
-        (list '> >)
-        (list '< <)
-        (list '= =)
-        (list 'print print)
-        (list 'map map)
-        ))
-
-(define (primitive-procedure-names)
-  (map car
-       primitive-procedures))
-
-(define (primitive-procedure-objects)
-  (map (lambda (proc) (list 'primitive (cadr proc)))
-       primitive-procedures))
-
-(define (primitive-proc-impl proc)
-  (cadr proc))
-
-(define primitive-vars
-  (list (list 'true #t)
-        (list 'false #f)
-        ))
-
-(define (primitive-var-names)
-  (map car
-       primitive-vars))
-
-(define (primitive-var-values)
-  (map cadr
-       primitive-vars))
-
-(define (primitive-names)
-  (append (primitive-procedure-names)
-          (primitive-var-names)))
-
-(define (primitive-values)
-  (append (primitive-procedure-objects)
-          (primitive-var-values)))
-
-(define (primitive-procedure? proc)
-  (tagged-list? proc 'primitive))
-
-(define (apply-primitive-procedure proc args)
-  (apply (primitive-proc-impl proc) args))
-
-; @(procedures)
-
-(define (compound-procedure? proc)
-  (tagged-list? proc 'procedure))
-
+; redefines make-procedure
 (define (make-procedure params body-seq env)
   (list 'procedure
         params
         (scan-out-defines body-seq #f)
         env))
 
-(define (procedure-parameters proc)
-  (cadr proc))
-
-(define (procedure-body proc)
-  (caddr proc))
+; fetch a list of values, eval them and return results as list
+(define (list-of-values exps env)
+  (if (null? exps)
+    '()
+    (cons (seck-eval (first-operand exps) env)
+          (list-of-values (rest-operands exps) env))))
+(define (seck-apply procedure arguments)
+  (cond ((primitive-procedure? procedure)
+         (apply-primitive-procedure procedure arguments))
+        ((compound-procedure? procedure)
+         (eval-sequence
+           (procedure-body procedure)
+           (extend-environment
+             (procedure-parameters procedure)
+             arguments
+             ; Here, we eval the expression in
+             ; a new env which extends procedure env(the
+             ; env in which procedure is defined). This 
+             ; ensures lexical scoping.
+             ; If we evaluate the procedure bodyin
+             ; the env that seck-apply is called, then
+             ; it will be dynamic scoping.
+             (procedure-env procedure))))
+        (else
+          (error
+            'seck-apply
+            "Unknown procedure type" procedure))))
 
-(define (procedure-env proc)
-  (cadddr proc))
+(define (eval-if exp env)
+  (if (seck-eval (if-predicate exp) env)
+    (seck-eval (if-consequent exp) env)
+    (seck-eval (if-alternative exp) env)))
+(define (eval-definition exp env)
+  (define-variable! (definition-var exp)
+                    (seck-eval (definition-value exp) env)
+                    env))
+(define (eval-assignment exp env)
+  (set-variable-value! (assignment-var exp)
+                       (seck-eval (assignment-value exp) env)
+                       env))
 
 (define (eval-sequence exps env)
   (cond ((null? exps)
@@ -261,6 +87,7 @@
           (seck-eval (first-exp exps) env)
           (eval-sequence (rest-exps exps) env))
         ))
+
 ; proc-body is a sequence of expressions to be evaluated
 (define (scan-out-defines proc-body do-scan-out)
   (let ((definitions (filter definition? proc-body))
@@ -284,280 +111,6 @@
                                    definitions)
                               non-definitions)))
       proc-body)))
-
-; @(assignment)
-
-(define (assignment? exp)
-  (tagged-list? exp 'set!))
-
-(define (assignment-var exp)
-  (cadr exp))
-
-(define (assignment-value exp)
-  (caddr exp))
-
-(define (eval-assignment exp env)
-  (set-variable-value! (assignment-var exp)
-                       (seck-eval (assignment-value exp) env)
-                       env))
-
-; @(defintion)
-
-(define (make-definition name value)
-  (list 'define name value))
-(define (definition? exp)
-  (tagged-list? exp 'define))
-
-(define (definition-var exp)
-  (if (symbol? (cadr exp))
-    (cadr exp)
-    (caadr exp)))
-
-(define (definition-value exp)
-  (if (symbol? (cadr exp))
-    (caddr exp)
-    (make-lambda (cdadr exp)
-                 (cddr exp))))
-
-(define (eval-definition exp env)
-  (define-variable! (definition-var exp)
-                    (seck-eval (definition-value exp) env)
-                    env))
-
-; @(if)
-
-(define (make-if predicate consequent . args)
-  (if (null? args)
-    (list 'if predicate consequent 'false)
-    (list 'if predicate consequent (car args))))
-
-(define (if? exp)
-  (tagged-list? exp 'if))
-
-(define (if-predicate exp)
-  (cadr exp))
-
-(define (if-consequent exp)
-  (caddr exp))
-
-(define (if-alternative exp)
-  (if (not (null? (cdddr exp)))
-    (cadddr exp)
-    'false))
-
-(define (eval-if exp env)
-  (if (seck-eval (if-predicate exp) env)
-    (seck-eval (if-consequent exp) env)
-    (seck-eval (if-alternative exp) env)))
-
-; @(cond)
-(define (cond? exp)
-  (tagged-list? exp 'cond))
-
-(define (cond-firstmatch matches)
-  (car matches))
-(define (cond-restmatches matches)
-  (cdr matches))
-(define (cond-lastmatch matches)
-  (null? (cdr matches)))
-(define (cond-elsematch? match)
-  (eq? (car match) 'else))
-
-(define (cond-match-predicate match)
-  (car match))
-
-(define (cond-match-actions match)
-  (cdr match))
-
-(define (cond->if exp)
-  (define (expand matches)
-    (if (null? matches)
-      'false
-      (let ((first (cond-firstmatch matches))
-            (rest (cond-restmatches matches)))
-        (cond ((cond-elsematch? first) ;else
-               (if (null? rest)
-                 (make-if 'true (sequence->exp (cond-match-actions first)))
-                 (error 'cond "else is not last match")))
-              (else ; the other conditions
-                (make-if (cond-match-predicate first)
-                         (sequence->exp-2 (cond-match-predicate first)
-                                          (cond-match-actions first))
-                         (expand rest)))))))
-  (expand (cdr exp)))
-
-; @(and/or)
-(define (and? exp)
-  (tagged-list? exp 'and))
-
-(define (or? exp)
-  (tagged-list? exp 'or))
-
-(define (and->if exp)
-  (define (expand exps)
-    (if (null? exps)
-      (make-if 'true 'true)
-      (make-if (car exps)
-               (expand (cdr exps))
-               'true)))
-  (expand (cdr exp)))
-
-(define (or->if exp)
-  (define (expand exps)
-    (if (null? exps)
-      (make-if 'true 'false)
-      (make-if (car exps)
-               'true
-               (expand (cdr exps)))))
-  (expand (cdr exp)))
-
-; @(lambda)
-
-(define (lambda? exp)
-  (tagged-list? exp 'lambda))
-
-(define (make-lambda params body-seq)
-  (cons 'lambda (cons params body-seq)))
-
-(define (lambda-params exp)
-  (cadr exp))
-
-(define (lambda-body exp)
-  (cddr exp))
-
-; @(let)
-(define (let? exp)
-  (tagged-list? exp 'let))
-
-(define (let-bindings exp)
-  (if (namedlet? exp)
-    (caddr exp)
-    (cadr exp)
-    ))
-
-(define (let-body exp)
-  (if (namedlet? exp)
-    (cdddr exp)
-    (cddr exp)
-    ))
-(define (let-vars exp) (map car (let-bindings exp)))
-; if you define let-values here, there will be 
-(define (let-vals exp) (map cadr (let-bindings exp)))
-(define (namedlet? exp) (symbol? (cadr exp)))
-(define (let->name exp) (cadr exp))
-
-(define (let->combination exp)
-  (if (namedlet? exp)
-    (cons (make-lambda '()
-                       (list (make-definition (let->name exp)
-                                              (make-lambda (let-vars exp)
-                                                           (let-body exp)))
-                             (cons (let->name exp)
-                                   (let-vals exp))
-                             ))
-          '())
-    (let->lambda (let-vars exp)
-                 (let-vals exp)
-                 (let-body exp))))
-
-(define (let->lambda vars values body)
-  (cons (make-lambda vars body)
-        values))
-
-(define (make-let var-bindings body)
-  (cons 'let
-        (cons var-bindings
-              body)))
-
-(define (letstar? exp)
-  (tagged-list? exp 'let*))
-
-(define (let*->nested-let exp)
-  (define (wrap-let-body vars values)
-    (cond ((and (null? vars)
-                (null? values))
-           (make-let '() (let-body exp)))
-          ((or (null? vars)
-               (null? values))
-           (error 'wrap-let-body "let vars-values length not match"))
-          (else
-            (make-let (list (list (car vars)
-                                  (car values)))
-                      (list (wrap-let-body (cdr vars)
-                                           (cdr values)))))
-          ))
-  (wrap-let-body (let-vars exp)
-                 (let-vals exp)  ; todo
-                 ))
-
-
-(define (letrec? exp)
-  (tagged-list? exp 'letrec))
-(define (letrec->let exp)
-  (make-let 
-    (map (lambda (var)
-           (list var ''*assigned*))
-         (let-vars exp))
-    (append (map (lambda (var value)
-                   (list 'set! var value))
-                 (let-vars exp)
-                 (let-vals exp))
-            (let-body exp))))
-
-; @(for)
-
-(define (for? exp)
-  (tagged-list? exp 'for))
-(define (for-init exp) (cadr exp))
-(define (for-can-continue exp) (caddr exp))
-(define (for-step exp) (cadddr exp))
-(define (for-body exp) (cddddr exp))
-
-
-
-; @(application)
-(define application? pair?)
-(define (operator exp) (car exp))
-(define (operand exp) (cdr exp))
-(define (first-operand exps) (car exps))
-(define (rest-operands exps) (cdr exps))
-; fetch a list of values, eval them and return results as list
-(define (list-of-values exps env)
-  (if (null? exps)
-    '()
-    (cons (seck-eval (first-operand exps) env)
-          (list-of-values (rest-operands exps) env))))
-(define (seck-apply procedure arguments)
-  (cond ((primitive-procedure? procedure)
-         (apply-primitive-procedure procedure arguments))
-        ((compound-procedure? procedure)
-         (eval-sequence
-           (procedure-body procedure)
-           (extend-environment
-             (procedure-parameters procedure)
-             arguments
-             ; Here, we eval the expression in
-             ; a new env which extends procedure env(the
-             ; env in which procedure is defined). This 
-             ; ensures lexical scoping.
-             ; If we evaluate the procedure bodyin
-             ; the env that seck-apply is called, then
-             ; it will be dynamic scoping.
-             (procedure-env procedure))))
-        (else
-          (error
-            'seck-apply
-            "Unknown procedure type" procedure))))
-
-
-; @(global env)
-(define (setup-environment)
-  (extend-environment (primitive-names)
-                      (primitive-values)
-                      the-empty-env))
-
-(define global-env (setup-environment))
-
 (define (init-test-env)
   (let ((new-env (make-env global-env)))
     (seck-eval '(define a 3) new-env)
diff --git a/src/eval/eval1.scm b/src/eval/eval1.scm
index 42f8f28..e9c388b 100644
--- a/src/eval/eval1.scm
+++ b/src/eval/eval1.scm
@@ -1,5 +1,17 @@
 ; a more efficient eval
+;
 
+;why analyze can improve performance
+     ;for eval without analyze
+          ;(define (foo x) x)
+          ;everytime, when you want to call foo, (foo x), it will first lookup variable foo, 
+          ;which is binder to a lambda, then you will make a procedure from the lambda, and then evaluate the procedure again.
+     ;for eval with analyze
+          ;(define (foo x) x)
+          ;everytime, when you want to call foo, (foo x), it will also lookup variable foo, which returns an analyzed procedure: proc,
+          ;and by call proc: (proc env), it directly returns the procedure(without remake it), which improves the performance.
+
+(load "eval-base.scm")
 (define (seck-eval exp env)
   ((analyze exp) env))
 
@@ -26,3 +38,79 @@
     (lambda (env) qval)))
 
 (define (analyze-quoted exp)
+  (let ((text (quoted-text exp)))
+    (lambda (env)
+      text)))
+
+(define (analyze-variable exp)
+  (lambda (env)
+    (lookup-variable-value exp env)))
+
+(define (analyze-definition exp)
+  (let ((var (definition-var exp))
+        (vproc (analyze (definition-value exp))))
+    (lambda (env)
+      (define-variable! var (vproc env) env)
+      'ok)))
+
+(define (analyze-if exp)
+  (let ((pproc (analyze (if-predicate exp)))
+        (cproc (analyze (if-consequent exp)))
+        (aproc (analyze (if-alternative exp))))
+    (lambda (env)
+      (if (pproc env)
+        (cproc env)
+        (aproc env)))))
+
+(define (analyze-lambda exp)
+  (let ((params (lambda-params exp))
+        (body-proc (analyze-sequence (lambda-body exp))))
+    (lambda (env) (make-procedure params body-proc env))))
+
+(define (analyze-sequence exp)
+  (define (combine-seq-proc seq-proc)
+    (if (null? (cdr seq-proc))
+      (car seq-proc)
+      (lambda (env)
+        ((car seq-proc) env)
+        ((combine-seq-proc (cdr seq-proc)) env))))
+  (let ((seq-proc (map analyze exp)))
+    (if (null? seq-proc)
+      (error 'analyze-sequence "no expression in code block")
+      (combine-seq-proc seq-proc))))
+
+(define (analyze-application exp)
+  (let ((fproc (analyze (operator exp)))
+        (aprocs (map analyze (operand exp))))
+    (lambda (env)
+      (execute-application (fproc env)
+                           (map (lambda (aproc)
+                                  (aproc env))
+                                aprocs)))))
+
+(define (execute-application proc args)
+  (cond ((primitive-procedure? proc)
+         (apply-primitive-procedure proc args))
+        ((compound-procedure? proc)
+         ((procedure-body proc)
+          (extend-environment (procedure-parameters proc)
+                              args
+                              (procedure-env proc))))
+        (else
+          (error
+            'execute-applicaiton
+            "unknown procedure type"
+            proc))))
+
+(define (analyze-assignment exp)
+  (error 'analyze-assignment "not implemented"))
+
+(define (test-analyze)
+  (seck-eval '(define (fact n)
+                (if (= n 1)
+                  1
+                  (* (fact (- n 1))
+                     n)))
+             global-env)
+  (println (seck-eval '(fact 3) global-env))
+  )

From 64a6521074ed0b8079a8b5015ad1dc01c946d833 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 17:43:33 +0800
Subject: [PATCH 65/75] c4 22

---
 src/eval/c4_22.scm |  1 +
 src/eval/eval.scm  |  2 +-
 src/eval/eval1.scm | 13 ++++++++++++-
 3 files changed, 14 insertions(+), 2 deletions(-)
 create mode 100644 src/eval/c4_22.scm

diff --git a/src/eval/c4_22.scm b/src/eval/c4_22.scm
new file mode 100644
index 0000000..9b3a329
--- /dev/null
+++ b/src/eval/c4_22.scm
@@ -0,0 +1 @@
+; in eval1.scm
diff --git a/src/eval/eval.scm b/src/eval/eval.scm
index 6b629e8..a0a55d3 100644
--- a/src/eval/eval.scm
+++ b/src/eval/eval.scm
@@ -81,7 +81,7 @@
 (define (eval-sequence exps env)
   (cond ((null? exps)
          (error 'eval-sequence "no expression in code in block"))
-        (( last-exp? exps)
+        ((last-exp? exps)
          (seck-eval (first-exp exps) env))
         (else
           (seck-eval (first-exp exps) env)
diff --git a/src/eval/eval1.scm b/src/eval/eval1.scm
index e9c388b..94006fb 100644
--- a/src/eval/eval1.scm
+++ b/src/eval/eval1.scm
@@ -26,6 +26,7 @@
         ((lambda? exp) (analyze-lambda exp))
         ((begin? exp) (analyze-sequence (begin-actions exp)))
         ((cond? exp) (analyze (cond->if exp)))
+        ((let? exp) (analyze (let->combination exp)))
         ((application? exp) (analyze-application exp))
         (else
           (error 'analyze "unknown expression type" exp))))
@@ -103,7 +104,10 @@
             proc))))
 
 (define (analyze-assignment exp)
-  (error 'analyze-assignment "not implemented"))
+  (let ((var (assignment-var exp))
+        (vproc (analyze (assignment-value exp))))
+    (lambda (env)
+      (set-variable-value! var (vproc env) env))))
 
 (define (test-analyze)
   (seck-eval '(define (fact n)
@@ -114,3 +118,10 @@
              global-env)
   (println (seck-eval '(fact 3) global-env))
   )
+
+(define (test-let)
+  (seck-eval '(let ((a 1)
+                    (b 2))
+                (set! a (* a b))
+                (+ a b))
+             global-env))

From 5ea25f0f0f7f744ce383a67a0b0518f495181e2c Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 20:10:34 +0800
Subject: [PATCH 66/75] c4 23

---
 src/eval/c4_23.scm |  5 +++++
 src/eval/eval1.scm | 43 ++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 45 insertions(+), 3 deletions(-)
 create mode 100644 src/eval/c4_23.scm

diff --git a/src/eval/c4_23.scm b/src/eval/c4_23.scm
new file mode 100644
index 0000000..36b4568
--- /dev/null
+++ b/src/eval/c4_23.scm
@@ -0,0 +1,5 @@
+; I've implemented one analyze-sequence in eval1.scm,
+; the text has a version of analyze-sequence(analyze-sequence-text in eval1.scm)
+; and analyze-sequence-alyssa has a version of analyze-sequence(analyze-sequence-alyssa).
+; Of those, analyze-sequence-text and my version are better. Since they try to expand all the sequence
+; during the analysis stage(try to add a print func in loop).
diff --git a/src/eval/eval1.scm b/src/eval/eval1.scm
index 94006fb..aa72314 100644
--- a/src/eval/eval1.scm
+++ b/src/eval/eval1.scm
@@ -69,17 +69,46 @@
     (lambda (env) (make-procedure params body-proc env))))
 
 (define (analyze-sequence exp)
+  (define (combine proc1 proc2)
+    (lambda (env)
+      (proc1 env)
+      (proc2 env)))
   (define (combine-seq-proc seq-proc)
+    ; (println "combine-seq-proc")
     (if (null? (cdr seq-proc))
       (car seq-proc)
-      (lambda (env)
-        ((car seq-proc) env)
-        ((combine-seq-proc (cdr seq-proc)) env))))
+      (combine (car seq-proc)
+               (combine-seq-proc (cdr seq-proc)))))
   (let ((seq-proc (map analyze exp)))
     (if (null? seq-proc)
       (error 'analyze-sequence "no expression in code block")
       (combine-seq-proc seq-proc))))
 
+(define (analyze-sequence-text exps)
+  (define (sequentially proc1 proc2)
+    (lambda (env) (proc1 env) (proc2 env)))
+  (define (loop first-proc rest-procs)
+    ; (println "loop")
+    (if (null? rest-procs)
+        first-proc
+        (loop (sequentially first-proc (car rest-procs))
+              (cdr rest-procs))))
+  (let ((procs (map analyze exps)))
+    (if (null? procs)
+        (error "Empty sequence -- ANALYZE"))
+    (loop (car procs) (cdr procs))))
+
+(define (analyze-sequence-alyssa exps)
+  (define (execute-sequence procs env)
+    (cond ((null? (cdr procs))
+           ((car procs) env))
+          (else ((car procs) env)
+                (execute-sequence (cdr procs) env))))
+  (let ((procs (map analyze exps)))
+    (if (null? procs)
+        (error "Empty sequence -- ANALYZE"))
+    (lambda (env) (execute-sequence procs env))))
+
 (define (analyze-application exp)
   (let ((fproc (analyze (operator exp)))
         (aprocs (map analyze (operand exp))))
@@ -125,3 +154,11 @@
                 (set! a (* a b))
                 (+ a b))
              global-env))
+
+(define seq1 '((set! a b)
+               (cons a b)
+               (cons a b)
+               (cons a b)
+               (cons a b)))
+
+(define seq2 '((cons a b)))

From 740da760dcdfd6e40089a0ea2be70737694e6c80 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 20:12:27 +0800
Subject: [PATCH 67/75] c4 24

---
 src/eval/c4_24.scm | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 src/eval/c4_24.scm

diff --git a/src/eval/c4_24.scm b/src/eval/c4_24.scm
new file mode 100644
index 0000000..fcdb36e
--- /dev/null
+++ b/src/eval/c4_24.scm
@@ -0,0 +1 @@
+; ...

From b708819b9dcd2587470bef19c973ff064e38f157 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 21:47:47 +0800
Subject: [PATCH 68/75] remove useless files

---
 little_book/little_scheme/{equal.rkt => equal.scm} | 0
 run.rkt                                            | 7 -------
 2 files changed, 7 deletions(-)
 rename little_book/little_scheme/{equal.rkt => equal.scm} (100%)
 delete mode 100644 run.rkt

diff --git a/little_book/little_scheme/equal.rkt b/little_book/little_scheme/equal.scm
similarity index 100%
rename from little_book/little_scheme/equal.rkt
rename to little_book/little_scheme/equal.scm
diff --git a/run.rkt b/run.rkt
deleted file mode 100644
index faebe23..0000000
--- a/run.rkt
+++ /dev/null
@@ -1,7 +0,0 @@
-#lang racket
-(require "exercise1.rkt")
-(require "newton.rkt")
-(require "counting_change.rkt")
-
-
-

From 2c3a0b6a618e6fab404a0217a25d2fdfb6c983cc Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Sun, 29 Sep 2013 21:54:49 +0800
Subject: [PATCH 69/75] move little schemer code

---
 little_book/little_scheme/equal.scm | 43 -------------------
 src/little-schemer/c5.scm           | 64 +++++++++++++++++++++++++++++
 2 files changed, 64 insertions(+), 43 deletions(-)
 delete mode 100644 little_book/little_scheme/equal.scm
 create mode 100644 src/little-schemer/c5.scm

diff --git a/little_book/little_scheme/equal.scm b/little_book/little_scheme/equal.scm
deleted file mode 100644
index 2187a7d..0000000
--- a/little_book/little_scheme/equal.scm
+++ /dev/null
@@ -1,43 +0,0 @@
-#lang racket
-
-; eq? : takes two non-numeric atom.
-; = : for numbers
-; eqan?: atom equal
-; eqlist?: list equal
-; equal? : s-expression equal
-
-; for real-world scheme: eq? is for reference equal
-; while equal? is for value equal.
-
-(require "base.rkt")
-
-(define (eqan? a1 a2)
-  (cond ((and (number? a1) (number? a2))
-         (= a1 a2))
-        ; one is number while the other is not
-        ((or (number? a1) (number? a2))
-         #f)
-        (else (eq? a1 a2))))
-
-
-(define (eqlist? l1 l2)
-  (cond ((and (null? l1) (null? l2)) #t)
-        ((or (null? l1) (null? l2)) #f)
-        ((and (atom? (car l1))
-              (atom? (car l2)))
-         (and (eqan? (car l1)
-                     (car l2))
-              (eqlist? (cdr l1)
-                       (cdr l2))))
-        ((or (atom? (car l1))
-             (atom? (car l2))) #f)
-        (else (and (eqlist? (car l1)
-                            (car l2))
-                   (eqlist? (cdr l1)
-                            (cdr l2))))))
-
-(define (equal? s1 s2)
-  (cond ((and (atom? s1) (atom? s2))
-         (eqan? s1 s2))
-        ((or (atom? s1) (atom? s2)) #f)
-        (else (eqlist? s1 s2))))
diff --git a/src/little-schemer/c5.scm b/src/little-schemer/c5.scm
new file mode 100644
index 0000000..92028e1
--- /dev/null
+++ b/src/little-schemer/c5.scm
@@ -0,0 +1,64 @@
+; eq? : takes two non-numeric atom.
+; = : for numbers
+; eqan?: atom equal
+; eqlist?: list equal
+; equal? : s-expression equal
+
+; for real-world scheme: eq? is for reference equal
+; while equal? is for value equal.
+
+(define (atom? s)
+  (and (not (pair? s))
+       (not (null? s))))
+
+; equivalent to guile's eq? 
+(define (eqan? a1 a2)
+  (cond ((and (number? a1) (number? a2))
+         (= a1 a2))
+        ; one is number while the other is not
+        ((or (number? a1) (number? a2))
+         #f)
+        (else (eq? a1 a2))))
+
+(define (eqlist? l1 l2)
+  (cond ((and (null? l1) (null? l2)) #t)
+        ((or (null? l1) (null? l2)) #f)
+        (else
+          (and (myequal? (car l1)
+                         (car l2))
+               (eqlist? (cdr l1)
+                        (cdr l2))))))
+
+(define (myequal? s1 s2)
+  (cond ((and (atom? s1) (atom? s2))
+         (eqan? s1 s2))
+        ((or (atom? s1) (atom? s2)) #f)
+        (else (eqlist? s1 s2))))
+
+
+(define rember
+  (lambda (s l)
+    (cond ((null? l) '())
+          ((myequal? s (car l))
+           (cdr l))
+          (else
+            (cons (car l)
+                  (rember s
+                          (cdr l)))))))
+
+(define insertL*
+  (lambda (new old l)
+    (cond ((null? l) '())
+          ((myequal? old (car l))
+           (cons new old (insertL* new old (cdr l))))
+          ((list? (car l))
+           (cons (insertL* new old (car l))
+                 (insertL* new old (cdr l))))
+          (else
+            (cons (car l)
+                  (insertL* new old (cdr l)))))))
+
+(define (test-insertL*)
+  (println (insertL* 'a 'b '(a b c))))
+
+

From 405b026b31d88ccb478c1462513f9ba129237dee Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 14 Oct 2013 15:11:24 +0800
Subject: [PATCH 70/75] little schemer c9

---
 src/little-schemer/c9.scm | 77 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 src/little-schemer/c9.scm

diff --git a/src/little-schemer/c9.scm b/src/little-schemer/c9.scm
new file mode 100644
index 0000000..3051096
--- /dev/null
+++ b/src/little-schemer/c9.scm
@@ -0,0 +1,77 @@
+(define (atom? x)
+  (and (not (pair? x)) (not (null? x))))
+
+; pair is consisted of two s-expressions
+; different from pair?
+(define (a-pair? x)
+  (cond ((atom? x) #f)
+        ((null? x) #f)
+        ((null? (cdr x)) #f)
+        ((null? (cdr (cdr x))) #t)
+        (else #f)))
+
+(define looking
+  (lambda (a lat)
+    (keep-looking a (pick 1 lat) lat)))
+
+(define (pick n lat)
+  (cond ((and (= n 1)
+             (not (null? lat)))
+         (car lat))
+        ((= n 1)
+         (error 'pick "lat is null"))
+        (else
+          (pick (- n 1)
+                (cdr lat)))))
+
+(define (keep-looking a sorn lat)
+  (cond ((number? sorn)
+         (keep-looking a (pick sorn lat) lat))
+        (else
+          (eq? a sorn))))
+          
+; build s1 and s2 into a list
+(define (build s1 s2)
+  (cons s1 (cons s2 '())))
+
+(define (first pair)
+  (car pair))
+
+(define (second pair)
+  (cadr pair))
+
+(define (shift pair)
+  (build (first (first pair))
+         (build (second (first pair))
+                (second pair))))
+
+; pora is a special pair of an atom. The special pair is a pair
+; consisted of two special pair or atom.
+; Example:
+;   '((1 2) ((3 4) (5 6)))
+;   align it
+;       '(1 (2 (3 (4 (5 6)))))
+(define (align pora)
+  (cond ((atom? pora) pora)
+        ((a-pair? (first pora))
+         (align (shift pora)))
+        (else (build (first pora)
+                     (align (second pora))))))
+
+(define (weight* pora)
+  (cond ((atom? pora) 1)
+        (else
+          (+ (* (weight* (first pora)) 2)
+             (weight* (second pora))))))
+
+
+; reverse a pair
+(define (revpair p)
+  (build (second p) (first p)))
+
+(define (shuffle pora)
+  (cond ((atom? pora) pora)
+        ((a-pair? (first pora))
+         (shuffle (revpair pora)))
+        (else (build (first pora)
+                     (shuffle (second pora))))))

From 47f3ea14c457c2fb67a6844b527e6bd655b026a6 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 14 Oct 2013 15:11:40 +0800
Subject: [PATCH 71/75] why y-combinator

---
 src/little-schemer/y-combinator.scm | 265 ++++++++++++++++++++++++++++
 1 file changed, 265 insertions(+)
 create mode 100644 src/little-schemer/y-combinator.scm

diff --git a/src/little-schemer/y-combinator.scm b/src/little-schemer/y-combinator.scm
new file mode 100644
index 0000000..1918353
--- /dev/null
+++ b/src/little-schemer/y-combinator.scm
@@ -0,0 +1,265 @@
+; the deduction of y-combinator
+(define (add1 x)
+  (+ x 1))
+
+(define (eternity x)
+  (eternity x))
+
+; initial length definition
+(define length
+  (lambda (l)
+    (cond ((null? l) 0)
+          (else
+            (add1 (length (cdr l)))))))
+
+; how to implement it without use of define
+; y-combinator
+
+; length0
+(lambda (l)
+  (cond ((null? l) 0)
+        (else
+          (add1 (eternity (cdr l))))))
+
+; length<=1
+(lambda (l)
+  (cond ((null? l) 0)
+        (else
+          (add1 ((lambda (l)
+                   (cond ((null? l) 0)
+                         (else
+                           (add1 (eternity (cdr l)))))))))))
+
+; abstract a function: mk-length
+; mk-length: makes length from function that looks like length
+(define mk-length
+  (lambda (length)
+    (lambda (l)
+      (cond ((null? l) 0)
+            (else
+              (add1 (length (cdr l))))))))
+
+; then, length0
+((lambda (length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 (length (cdr l)))))))
+ eternity)
+
+; that is
+(make-length eternity)
+
+; then, length<=1
+((lambda (length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 (length (cdr l)))))))
+ ((lambda (length)
+    (lambda (l)
+      (cond ((null? l) 0)
+            (else
+              (add1 (length (cdr l)))))))
+  eternity))
+
+; that is
+(make-length length0)
+
+; = 
+(make-length
+  (make-length eternity))
+
+; length<=2
+((lambda (length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 (length (cdr l)))))))
+ ((lambda (length)
+    (lambda (l)
+      (cond ((null? l) 0)
+            (else
+              (add1 (length (cdr l)))))))
+  ((lambda (length)
+     (lambda (l)
+       (cond ((null? l) 0)
+             (else
+               (add1 (length (cdr l)))))))
+   eternity)))
+
+; that is
+(make-length
+  (make-length
+    (make-length eternity)))
+
+; make use of mk-length without define
+
+; length0
+((lambda (mk-length)
+   (mk-length eternity))
+ (lambda (length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 (length (cdr l))))))))
+
+; length<=1
+((lambda (mk-length)
+   (mk-length
+     (mk-length eternity)))
+ (lambda (length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 (length (cdr l))))))))
+
+
+; this can also be written as
+
+((lambda (mk-length)
+   (mk-length mk-length))
+ (lambda (mk-length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 ((mk-length eternity)
+                    (cdr l))))))))
+
+; we don't care about the eternity func,
+; it can be anything
+((lambda (mk-length)
+   (mk-length mk-length))
+ (lambda (mk-length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 ((mk-length mk-length)
+                    (cdr l))))))))
+
+; we also want to use our mk-length func defintion.
+; then we have
+((lambda (mk-length)
+   (mk-length mk-length))
+ (lambda (mk-length)
+   ; here is our mk-length
+   ((lambda (length)
+      (lambda (l)
+        (cond ((null? l) 0)
+              (else
+                (add1 (length
+                        (cdr l)))))))
+    (mk-length mk-length))))
+
+
+; try to expand it
+((lambda (mk-length)
+   ((lambda (length)
+      (lambda (l)
+        (cond ((null? l) 0)
+              (else
+                (add1 (length
+                        (cdr l)))))))
+    (mk-length mk-length)))
+ (lambda (mk-length)
+   ((lambda (length)
+      (lambda (l)
+        (cond ((null? l) 0)
+              (else
+                (add1 (length
+                        (cdr l)))))))
+    (mk-length mk-length))))
+
+; again...
+; Oh, shit! this is a infinite recursion
+((lambda (length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 (length
+                     (cdr l)))))))
+ ; infinite recursion here when evaluate this.
+ ; the problem is that, before we can evaluate the mk-length body
+ ; wrap in lambda, we will first evaluate it's argument: (mk-length mk-length),
+ ; which is recursive. therefore we need to make it lazy(evaluate when we really need
+ ; it)
+ ((lambda (mk-length)
+    ((lambda (length)
+       (lambda (l)
+         (cond ((null? l) 0)
+               (else
+                 (add1 (length
+                         (cdr l)))))))
+     (mk-length mk-length)))
+  (lambda (mk-length)
+    ((lambda (length)
+       (lambda (l)
+         (cond ((null? l) 0)
+               (else
+                 (add1 (length
+                         (cdr l)))))))
+     (mk-length mk-length)))))
+
+; make it lazy
+(f x) = ((lambda (x)
+           (f x))
+         x)
+
+((lambda (mk-length)
+   (mk-length mk-length))
+ (lambda (mk-length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 ((lambda (x)
+                      ((mk-length mk-length) x))
+                    (cdr l))))))))
+
+; we want to use our mk-length func defintion
+; then we have
+((lambda (mk-length)
+   (mk-length mk-length))
+ (lambda (mk-length)
+   ; here is our mk-length
+   ((lambda (length)
+      (lambda (l)
+        (cond ((null? l) 0)
+              (else
+                (add1
+                  ; lazy func will be evaluated here.
+                  (length (cdr l)))))))
+    ; here, the argument will not be evaluate until we call length
+    (lambda (x)
+      ((mk-length mk-length) x)))))
+
+; how about extract mk-length definition, name it le
+((lambda (le)
+   ((lambda (mk-length)
+      (mk-length mk-length))
+    (lambda (mk-length)
+      (le
+        (lambda (x)
+          ((mk-length mk-length) x))))))
+ ; mk-length here
+ (lambda (length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 (length (cdr l))))))))
+
+; we define the part that is not related to length/mk-length as Y
+; that is y-combinator
+(define Y
+  (lambda (le)
+    ((lambda (f) (f f))
+     (lambda (f)
+       (le (lambda (x) ((f f) x)))))))
+
+(define mk-length
+  (lambda (length)
+    (lambda (l)
+      (cond ((null? l) 0)
+            (else
+              (add1 (length (cdr l))))))))
+
+(Y mk-length) = length

From c6325b3d23271d17a2431cb780624903e2487a9b Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 14 Oct 2013 15:12:54 +0800
Subject: [PATCH 72/75] update y-combinator

---
 src/little-schemer/y-combinator.scm | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/little-schemer/y-combinator.scm b/src/little-schemer/y-combinator.scm
index 1918353..65a3ed7 100644
--- a/src/little-schemer/y-combinator.scm
+++ b/src/little-schemer/y-combinator.scm
@@ -1,10 +1,13 @@
-; the deduction of y-combinator
+; why we have y-combinator
+
+; ok, some helper function
 (define (add1 x)
   (+ x 1))
 
 (define (eternity x)
   (eternity x))
 
+; take length as example
 ; initial length definition
 (define length
   (lambda (l)

From 93048584cf2fff8b09d87cf7c3e81489ff9ef846 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 14 Oct 2013 15:50:18 +0800
Subject: [PATCH 73/75] y combinator for js

---
 src/little-schemer/y-combinator.js | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)
 create mode 100644 src/little-schemer/y-combinator.js

diff --git a/src/little-schemer/y-combinator.js b/src/little-schemer/y-combinator.js
new file mode 100644
index 0000000..28b7e29
--- /dev/null
+++ b/src/little-schemer/y-combinator.js
@@ -0,0 +1,18 @@
+function Y (g) {
+    return (function (f) {
+        return f(f);
+    })(function (f) {
+        return g(function () {
+            return f(f).apply(null, arguments);
+        });
+    });
+};
+
+
+var fib = Y(function (fib_t) {
+    return function (n) {
+        if (n == 0) return 0;
+        if (n == 1) return 1;
+        return fib_t(n-1) + fib_t(n-2);
+    };
+});

From 3990c95a21ae8222abacb8c4bfd34a8b43d114d6 Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 14 Oct 2013 15:50:44 +0800
Subject: [PATCH 74/75] y-combinator for js update

---
 src/little-schemer/y-combinator.js  | 4 +++-
 src/little-schemer/y-combinator.scm | 4 ++--
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/little-schemer/y-combinator.js b/src/little-schemer/y-combinator.js
index 28b7e29..dda530c 100644
--- a/src/little-schemer/y-combinator.js
+++ b/src/little-schemer/y-combinator.js
@@ -13,6 +13,8 @@ var fib = Y(function (fib_t) {
     return function (n) {
         if (n == 0) return 0;
         if (n == 1) return 1;
-        return fib_t(n-1) + fib_t(n-2);
+        return fib(n-1) + fib(n-2);
     };
 });
+
+console.log(fib(10));
diff --git a/src/little-schemer/y-combinator.scm b/src/little-schemer/y-combinator.scm
index 65a3ed7..b239b7d 100644
--- a/src/little-schemer/y-combinator.scm
+++ b/src/little-schemer/y-combinator.scm
@@ -253,10 +253,10 @@
 ; we define the part that is not related to length/mk-length as Y
 ; that is y-combinator
 (define Y
-  (lambda (le)
+  (lambda (g)
     ((lambda (f) (f f))
      (lambda (f)
-       (le (lambda (x) ((f f) x)))))))
+       (g (lambda (x) ((f f) x)))))))
 
 (define mk-length
   (lambda (length)

From ad804cfb828356256221180d15b59bcb2760900a Mon Sep 17 00:00:00 2001
From: seckcoder <seckcoder@gmail.com>
Date: Mon, 14 Oct 2013 16:06:01 +0800
Subject: [PATCH 75/75] y-combinator update

---
 src/little-schemer/y-combinator.scm | 102 ++++++++++++++++++++++++++++
 1 file changed, 102 insertions(+)

diff --git a/src/little-schemer/y-combinator.scm b/src/little-schemer/y-combinator.scm
index b239b7d..11fb969 100644
--- a/src/little-schemer/y-combinator.scm
+++ b/src/little-schemer/y-combinator.scm
@@ -266,3 +266,105 @@
               (add1 (length (cdr l))))))))
 
 (Y mk-length) = length
+
+
+; try to expand it
+
+(Y mk-length)
+
+((lambda (le)
+   ((lambda (mk-length)
+      (mk-length mk-length))
+    (lambda (mk-length)
+      (le
+        (lambda (x)
+          ((mk-length mk-length) x))))))
+ (lambda (length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 (length (cdr l))))))))
+
+; expand
+((lambda (mk-length)
+   (mk-length mk-length))
+ (lambda (mk-length)
+   ((lambda (length)
+      (lambda (l)
+        (cond ((null? l) 0)
+              (else
+                (add1 (length (cdr l)))))))
+    (lambda (x)
+      ((mk-length mk-length) x)))))
+
+; expand
+
+((lambda (mk-length)
+   ((lambda (length)
+      (lambda (l)
+        (cond ((null? l) 0)
+              (else
+                (add1 (length (cdr l)))))))
+    (lambda (x)
+      ((mk-length mk-length) x))))
+ (lambda (mk-length)
+   ((lambda (length)
+      (lambda (l)
+        (cond ((null? l) 0)
+              (else
+                (add1 (length (cdr l)))))))
+    (lambda (x)
+      ((mk-length mk-length) x)))))
+
+; expand
+
+((lambda (length)
+   (lambda (l)
+     (cond ((null? l) 0)
+           (else
+             (add1 (length (cdr l)))))))
+ (lambda (x)
+   (((lambda (mk-length)
+       ((lambda (length)
+          (lambda (l)
+            (cond ((null? l) 0)
+                  (else
+                    (add1 (length (cdr l)))))))
+        (lambda (x)
+          ((mk-length mk-length) x))))
+     (lambda (mk-length)
+       ((lambda (length)
+          (lambda (l)
+            (cond ((null? l) 0)
+                  (else
+                    (add1 (length (cdr l)))))))
+        (lambda (x)
+          ((mk-length mk-length) x)))))
+    x)))
+
+; expand
+
+(lambda (l)
+  (cond ((null? l) 0)
+        (else
+          (add1 ((lambda (x)
+                   (((lambda (mk-length)
+                       ((lambda (length)
+                          (lambda (l)
+                            (cond ((null? l) 0)
+                                  (else
+                                    (add1 (length (cdr l)))))))
+                        (lambda (x)
+                          ((mk-length mk-length) x))))
+                     (lambda (mk-length)
+                       ((lambda (length)
+                          (lambda (l)
+                            (cond ((null? l) 0)
+                                  (else
+                                    (add1 (length (cdr l)))))))
+                        (lambda (x)
+                          ((mk-length mk-length) x)))))
+                    x))
+                 (cdr l))))))
+
+; that's it.