From 9be7ffc5fc9e54253f2b82ff6ff4c68ea816dd88 Mon Sep 17 00:00:00 2001
From: OGINO Masanori <masanori.ogino@gmail.com>
Date: Sun, 19 Jan 2014 17:15:30 +0900
Subject: [PATCH 01/16] Define the type of marking flags as unsigned int.

We could define it as _Bool since we are going to use C99, but unsigned
int is more portable (even in C89!) and extensible (when we decide to
use tri-color marking GC.)

Signed-off-by: OGINO Masanori <masanori.ogino@gmail.com>
---
 include/picrin/gc.h | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/include/picrin/gc.h b/include/picrin/gc.h
index d8a36cb6..1495abe4 100644
--- a/include/picrin/gc.h
+++ b/include/picrin/gc.h
@@ -9,16 +9,14 @@
 extern "C" {
 #endif
 
-enum pic_gc_mark {
-  PIC_GC_UNMARK = 0,
-  PIC_GC_MARK
-};
+#define PIC_GC_UNMARK 0
+#define PIC_GC_MARK 1
 
 union header {
   struct {
     union header *ptr;
     size_t size;
-    enum pic_gc_mark mark : 1;
+    unsigned int mark : 1;
   } s;
   long alignment[2];
 };

From 799e26cff03599036c90ce97fdc970e6f1b05faf Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 20:44:55 +0900
Subject: [PATCH 02/16] increate gc header alignment size

---
 include/picrin/gc.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/include/picrin/gc.h b/include/picrin/gc.h
index 1495abe4..19399810 100644
--- a/include/picrin/gc.h
+++ b/include/picrin/gc.h
@@ -18,7 +18,7 @@ union header {
     size_t size;
     unsigned int mark : 1;
   } s;
-  long alignment[2];
+  long alignment[4];
 };
 
 struct heap_page {

From a443d9e3f6be9d45fb3443401d5940fb5cc67613 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 20:57:05 +0900
Subject: [PATCH 03/16] add pic_list_ref and pic_list_tail

---
 include/picrin/pair.h |  3 +++
 src/pair.c            | 15 +++++++++++++++
 2 files changed, 18 insertions(+)

diff --git a/include/picrin/pair.h b/include/picrin/pair.h
index 1aed0d98..02599ff6 100644
--- a/include/picrin/pair.h
+++ b/include/picrin/pair.h
@@ -29,6 +29,9 @@ pic_value pic_cadr(pic_state *, pic_value);
 pic_value pic_cdar(pic_state *, pic_value);
 pic_value pic_cddr(pic_state *, pic_value);
 
+pic_value pic_list_tail(pic_state *, pic_value ,int);
+pic_value pic_list_ref(pic_state *, pic_value, int);
+
 #if defined(__cplusplus)
 }
 #endif
diff --git a/src/pair.c b/src/pair.c
index e6762221..ee443f68 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -180,6 +180,21 @@ pic_cddr(pic_state *pic, pic_value v)
   return pic_cdr(pic, pic_cdr(pic, v));
 }
 
+pic_value
+pic_list_tail(pic_state *pic, pic_value list, int i)
+{
+  while (i-- > 0) {
+    list = pic_cdr(pic, list);
+  }
+  return list;
+}
+
+pic_value
+pic_list_ref(pic_state *pic, pic_value list, int i)
+{
+  return pic_car(pic, pic_list_tail(pic, list, i));
+}
+
 static pic_value
 pic_pair_pair_p(pic_state *pic)
 {

From 7865cfe9b3f20a8e47117d1fc075f0e2ad7642ce Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 20:57:14 +0900
Subject: [PATCH 04/16] add pic_append

---
 include/picrin/pair.h |  1 +
 src/pair.c            | 17 +++++++++++++++++
 2 files changed, 18 insertions(+)

diff --git a/include/picrin/pair.h b/include/picrin/pair.h
index 02599ff6..f2ba887e 100644
--- a/include/picrin/pair.h
+++ b/include/picrin/pair.h
@@ -19,6 +19,7 @@ pic_value pic_list_from_array(pic_state *, size_t, pic_value *);
 
 int pic_length(pic_state *, pic_value);
 pic_value pic_reverse(pic_state *, pic_value);
+pic_value pic_append(pic_state *, pic_value, pic_value);
 
 pic_value pic_assq(pic_state *, pic_value key, pic_value assoc);
 pic_value pic_assoc(pic_state *, pic_value key, pic_value assoc);
diff --git a/src/pair.c b/src/pair.c
index ee443f68..989af584 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -114,6 +114,23 @@ pic_reverse(pic_state *pic, pic_value list)
   return acc;
 }
 
+pic_value
+pic_append(pic_state *pic, pic_value xs, pic_value ys)
+{
+  int ai = pic_gc_arena_preserve(pic);
+
+  if (pic_nil_p(xs)) {
+    return ys;
+  }
+  else {
+    xs = pic_cons(pic, pic_car(pic, xs), pic_append(pic, pic_cdr(pic, xs), ys));
+  }
+
+  pic_gc_arena_restore(pic, ai);
+  pic_gc_protect(pic, xs);
+  return xs;
+}
+
 pic_value
 pic_assq(pic_state *pic, pic_value key, pic_value assoc)
 {

From 67d4d28d192adf34a79be170a94b4e7490c6803b Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 21:00:29 +0900
Subject: [PATCH 05/16] impl list-ref and list-tail as C functions

---
 piclib/built-in.scm |  8 --------
 src/pair.c          | 24 ++++++++++++++++++++++++
 2 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 10c890a7..a2f310a7 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -517,14 +517,6 @@
 	  (reverse (cdr list)
 		   (cons (car list) (car args))))))
 
-(define (list-tail list k)
-  (if (zero? k)
-      list
-      (list-tail (cdr list) (- k 1))))
-
-(define (list-ref list k)
-  (car (list-tail list k)))
-
 (define (list-set! list k obj)
   (set-car! (list-tail list k) obj))
 
diff --git a/src/pair.c b/src/pair.c
index 989af584..e9489a00 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -290,6 +290,28 @@ pic_pair_set_cdr(pic_state *pic)
   return pic_none_value();
 }
 
+static pic_value
+pic_pair_list_tail(pic_state *pic)
+{
+  pic_value list;
+  int i;
+
+  pic_get_args(pic, "oi", &list, &i);
+
+  return pic_list_tail(pic, list, i);
+}
+
+static pic_value
+pic_pair_list_ref(pic_state *pic)
+{
+  pic_value list;
+  int i;
+
+  pic_get_args(pic, "oi", &list, &i);
+
+  return pic_list_ref(pic, list, i);
+}
+
 void
 pic_init_pair(pic_state *pic)
 {
@@ -300,4 +322,6 @@ pic_init_pair(pic_state *pic)
   pic_defun(pic, "cons", pic_pair_cons);
   pic_defun(pic, "set-car!", pic_pair_set_car);
   pic_defun(pic, "set-cdr!", pic_pair_set_cdr);
+  pic_defun(pic, "list-tail", pic_pair_list_tail);
+  pic_defun(pic, "list-ref", pic_pair_list_ref);
 }

From bbd1ec3fbbdb493aa7dcd25b4535c6a020578f68 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 21:14:10 +0900
Subject: [PATCH 06/16] replace length/reverse/append impls with c functions

---
 piclib/built-in.scm | 19 --------------
 src/pair.c          | 61 +++++++++++++++++++++++++++++++++++++--------
 2 files changed, 50 insertions(+), 30 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index a2f310a7..9009a157 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -498,25 +498,6 @@
 	  (cons (car args)
 		(make-list (- k 1) (car args))))))
 
-(define (length list)
-  (if (null? list)
-      0
-      (+ 1 (length (cdr list)))))
-
-(define (append xs ys)
-  (if (null? xs)
-      ys
-      (cons (car xs)
-            (append (cdr xs) ys))))
-
-(define (reverse list . args)
-  (if (null? args)
-      (reverse list '())
-      (if (null? list)
-	  (car args)
-	  (reverse (cdr list)
-		   (cons (car list) (car args))))))
-
 (define (list-set! list k obj)
   (set-car! (list-tail list k) obj))
 
diff --git a/src/pair.c b/src/pair.c
index e9489a00..8607f94c 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -242,16 +242,6 @@ pic_pair_cdr(pic_state *pic)
   return pic_cdr(pic, v);
 }
 
-static pic_value
-pic_pair_null_p(pic_state *pic)
-{
-  pic_value v;
-
-  pic_get_args(pic, "o", &v);
-
-  return pic_bool_value(pic_nil_p(v));
-}
-
 static pic_value
 pic_pair_cons(pic_state *pic)
 {
@@ -290,6 +280,52 @@ pic_pair_set_cdr(pic_state *pic)
   return pic_none_value();
 }
 
+static pic_value
+pic_pair_null_p(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  return pic_bool_value(pic_nil_p(v));
+}
+
+static pic_value
+pic_pair_length(pic_state *pic)
+{
+  pic_value list;
+
+  pic_get_args(pic, "o", &list);
+
+  return pic_int_value(pic_length(pic, list));
+}
+
+static pic_value
+pic_pair_append(pic_state *pic)
+{
+  size_t argc;
+  pic_value *args, list;
+
+  pic_get_args(pic, "*", &argc, &args);
+
+  list = args[--argc];
+
+  while (argc-- > 0) {
+    list = pic_append(pic, args[argc], list);
+  }
+  return list;
+}
+
+static pic_value
+pic_pair_reverse(pic_state *pic)
+{
+  pic_value list;
+
+  pic_get_args(pic, "o", &list);
+
+  return pic_reverse(pic, list);
+}
+
 static pic_value
 pic_pair_list_tail(pic_state *pic)
 {
@@ -318,10 +354,13 @@ pic_init_pair(pic_state *pic)
   pic_defun(pic, "pair?", pic_pair_pair_p);
   pic_defun(pic, "car", pic_pair_car);
   pic_defun(pic, "cdr", pic_pair_cdr);
-  pic_defun(pic, "null?", pic_pair_null_p);
   pic_defun(pic, "cons", pic_pair_cons);
   pic_defun(pic, "set-car!", pic_pair_set_car);
   pic_defun(pic, "set-cdr!", pic_pair_set_cdr);
+  pic_defun(pic, "null?", pic_pair_null_p);
+  pic_defun(pic, "length", pic_pair_length);
+  pic_defun(pic, "append", pic_pair_append);
+  pic_defun(pic, "reverse", pic_pair_reverse);
   pic_defun(pic, "list-tail", pic_pair_list_tail);
   pic_defun(pic, "list-ref", pic_pair_list_ref);
 }

From 7fc2885fad881b323a23f2e70bc915d251c6364a Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 21:20:13 +0900
Subject: [PATCH 07/16] replace list impl by scheme with impl by C

---
 piclib/built-in.scm | 14 +-------------
 src/pair.c          | 12 ++++++++++++
 2 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 9009a157..6a5c4e62 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -35,8 +35,6 @@
 (define-library (picrin bootstrap-tools)
   (import (scheme base))
 
-  (define (list . args) args)
-
   (define (caar p) (car (car p)))
   (define (cadr p) (car (cdr p)))
   (define (cdar p) (cdr (car p)))
@@ -51,14 +49,7 @@
         (cons (f (car list))
               (map f (cdr list)))))
 
-  (define (append xs ys)
-    (if (null? xs)
-        ys
-        (cons (car xs)
-              (append (cdr xs) ys))))
-
-  (export list map append
-          caar cadr cdar cddr
+  (export map caar cadr cdar cddr
           cadar caddr cdddr))
 
 ;;; core syntaces
@@ -475,9 +466,6 @@
 	  (list? (cdr obj))
 	  #f)))
 
-(define (list . args)
-  args)
-
 (define (caar p)
   (car (car p)))
 
diff --git a/src/pair.c b/src/pair.c
index 8607f94c..e6a5255c 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -290,6 +290,17 @@ pic_pair_null_p(pic_state *pic)
   return pic_bool_value(pic_nil_p(v));
 }
 
+static pic_value
+pic_pair_list(pic_state *pic)
+{
+  size_t argc;
+  pic_value *argv;
+
+  pic_get_args(pic, "*", &argc, &argv);
+
+  return pic_list_from_array(pic, argc, argv);
+}
+
 static pic_value
 pic_pair_length(pic_state *pic)
 {
@@ -358,6 +369,7 @@ pic_init_pair(pic_state *pic)
   pic_defun(pic, "set-car!", pic_pair_set_car);
   pic_defun(pic, "set-cdr!", pic_pair_set_cdr);
   pic_defun(pic, "null?", pic_pair_null_p);
+  pic_defun(pic, "list", pic_pair_list);
   pic_defun(pic, "length", pic_pair_length);
   pic_defun(pic, "append", pic_pair_append);
   pic_defun(pic, "reverse", pic_pair_reverse);

From d07456466dd58a57a60fc6905ca2bbe2a73b5e09 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 21:29:11 +0900
Subject: [PATCH 08/16] replace cxxr and list? impls by scheme with ones by C

---
 piclib/built-in.scm | 26 +----------------
 src/pair.c          | 68 +++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 63 insertions(+), 31 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 6a5c4e62..2e30a7f7 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -35,10 +35,6 @@
 (define-library (picrin bootstrap-tools)
   (import (scheme base))
 
-  (define (caar p) (car (car p)))
-  (define (cadr p) (car (cdr p)))
-  (define (cdar p) (cdr (car p)))
-  (define (cddr p) (cdr (cdr p)))
   (define (cadar p) (car (cdar p)))
   (define (caddr p) (car (cddr p)))
   (define (cdddr p) (cdr (cddr p)))
@@ -49,8 +45,7 @@
         (cons (f (car list))
               (map f (cdr list)))))
 
-  (export map caar cadr cdar cddr
-          cadar caddr cdddr))
+  (export map cadar caddr cdddr))
 
 ;;; core syntaces
 (define-library (picrin core-syntax)
@@ -459,25 +454,6 @@
 
 ;;; 6.4 Pairs and lists
 
-(define (list? obj)
-  (if (null? obj)
-      #t
-      (if (pair? obj)
-	  (list? (cdr obj))
-	  #f)))
-
-(define (caar p)
-  (car (car p)))
-
-(define (cadr p)
-  (car (cdr p)))
-
-(define (cdar p)
-  (cdr (car p)))
-
-(define (cddr p)
-  (cdr (cdr p)))
-
 (define (make-list k . args)
   (if (null? args)
       (make-list k #f)
diff --git a/src/pair.c b/src/pair.c
index e6a5255c..8f39df43 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -48,8 +48,9 @@ pic_cdr(pic_state *pic, pic_value obj)
 bool
 pic_list_p(pic_state *pic, pic_value obj)
 {
-  while (pic_pair_p(obj))
+  while (pic_pair_p(obj)) {
     obj = pic_pair_ptr(obj)->cdr;
+  }
 
   return pic_nil_p(obj);
 }
@@ -222,6 +223,16 @@ pic_pair_pair_p(pic_state *pic)
   return pic_bool_value(pic_pair_p(v));
 }
 
+static pic_value
+pic_pair_cons(pic_state *pic)
+{
+  pic_value v,w;
+
+  pic_get_args(pic, "oo", &v, &w);
+
+  return pic_cons(pic, v, w);
+}
+
 static pic_value
 pic_pair_car(pic_state *pic)
 {
@@ -243,13 +254,43 @@ pic_pair_cdr(pic_state *pic)
 }
 
 static pic_value
-pic_pair_cons(pic_state *pic)
+pic_pair_caar(pic_state *pic)
 {
-  pic_value v,w;
+  pic_value v;
 
-  pic_get_args(pic, "oo", &v, &w);
+  pic_get_args(pic, "o", &v);
 
-  return pic_cons(pic, v, w);
+  return pic_caar(pic, v);
+}
+
+static pic_value
+pic_pair_cadr(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  return pic_cadr(pic, v);
+}
+
+static pic_value
+pic_pair_cdar(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  return pic_cdar(pic, v);
+}
+
+static pic_value
+pic_pair_cddr(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  return pic_cddr(pic, v);
 }
 
 static pic_value
@@ -290,6 +331,16 @@ pic_pair_null_p(pic_state *pic)
   return pic_bool_value(pic_nil_p(v));
 }
 
+static pic_value
+pic_pair_list_p(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  return pic_bool_value(pic_list_p(pic, v));
+}
+
 static pic_value
 pic_pair_list(pic_state *pic)
 {
@@ -363,12 +414,17 @@ void
 pic_init_pair(pic_state *pic)
 {
   pic_defun(pic, "pair?", pic_pair_pair_p);
+  pic_defun(pic, "cons", pic_pair_cons);
   pic_defun(pic, "car", pic_pair_car);
   pic_defun(pic, "cdr", pic_pair_cdr);
-  pic_defun(pic, "cons", pic_pair_cons);
   pic_defun(pic, "set-car!", pic_pair_set_car);
   pic_defun(pic, "set-cdr!", pic_pair_set_cdr);
+  pic_defun(pic, "caar", pic_pair_caar);
+  pic_defun(pic, "cadr", pic_pair_cadr);
+  pic_defun(pic, "cdar", pic_pair_cdar);
+  pic_defun(pic, "cddr", pic_pair_cddr);
   pic_defun(pic, "null?", pic_pair_null_p);
+  pic_defun(pic, "list?", pic_pair_list_p);
   pic_defun(pic, "list", pic_pair_list);
   pic_defun(pic, "length", pic_pair_length);
   pic_defun(pic, "append", pic_pair_append);

From 74088d0130db50112533b1bfc09ef1e392b576c5 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 21:35:13 +0900
Subject: [PATCH 09/16] replace list-set! impl with C impl

---
 include/picrin/pair.h |  1 +
 piclib/built-in.scm   |  3 ---
 src/pair.c            | 20 ++++++++++++++++++++
 3 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/include/picrin/pair.h b/include/picrin/pair.h
index f2ba887e..20b48dfd 100644
--- a/include/picrin/pair.h
+++ b/include/picrin/pair.h
@@ -32,6 +32,7 @@ pic_value pic_cddr(pic_state *, pic_value);
 
 pic_value pic_list_tail(pic_state *, pic_value ,int);
 pic_value pic_list_ref(pic_state *, pic_value, int);
+void pic_list_set(pic_state *, pic_value, int, pic_value);
 
 #if defined(__cplusplus)
 }
diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 2e30a7f7..248ab4e2 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -462,9 +462,6 @@
 	  (cons (car args)
 		(make-list (- k 1) (car args))))))
 
-(define (list-set! list k obj)
-  (set-car! (list-tail list k) obj))
-
 (define (list-copy obj)
   (if (null? obj)
       obj
diff --git a/src/pair.c b/src/pair.c
index 8f39df43..3c1e8bbc 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -213,6 +213,12 @@ pic_list_ref(pic_state *pic, pic_value list, int i)
   return pic_car(pic, pic_list_tail(pic, list, i));
 }
 
+void
+pic_list_set(pic_state *pic, pic_value list, int i, pic_value obj)
+{
+  pic_pair_ptr(pic_list_tail(pic, list, i))->car = obj;
+}
+
 static pic_value
 pic_pair_pair_p(pic_state *pic)
 {
@@ -410,6 +416,19 @@ pic_pair_list_ref(pic_state *pic)
   return pic_list_ref(pic, list, i);
 }
 
+static pic_value
+pic_pair_list_set(pic_state *pic)
+{
+  pic_value list, obj;
+  int i;
+
+  pic_get_args(pic, "oio", &list, &i, &obj);
+
+  pic_list_set(pic, list, i, obj);
+
+  return pic_none_value();
+}
+
 void
 pic_init_pair(pic_state *pic)
 {
@@ -431,4 +450,5 @@ pic_init_pair(pic_state *pic)
   pic_defun(pic, "reverse", pic_pair_reverse);
   pic_defun(pic, "list-tail", pic_pair_list_tail);
   pic_defun(pic, "list-ref", pic_pair_list_ref);
+  pic_defun(pic, "list-set!", pic_pair_list_set);
 }

From e417439f4ae9b7bb73d024a90707fc0cb8f4bf9a Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 21:36:32 +0900
Subject: [PATCH 10/16] reduce exports

---
 piclib/built-in.scm | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 248ab4e2..c7bb790a 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -512,9 +512,7 @@
 	    (car list)
 	    (assoc obj (cdr list) compare)))))
 
-(export list? list caar cadr cdar cddr
-        make-list length append reverse
-        list-tail list-ref list-set! list-copy
+(export make-list list-copy
         memq memv member
         assq assv assoc)
 

From 85a5745716b154ef84edd3b34a761a32cb01d8d6 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 22:18:25 +0900
Subject: [PATCH 11/16] native implmentation of map

---
 piclib/built-in.scm | 29 ++---------------------------
 src/proc.c          | 39 ++++++++++++++++++++++++++++++++-------
 2 files changed, 34 insertions(+), 34 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index c7bb790a..fbccc797 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -39,13 +39,7 @@
   (define (caddr p) (car (cddr p)))
   (define (cdddr p) (cdr (cddr p)))
 
-  (define (map f list)
-    (if (null? list)
-        list
-        (cons (f (car list))
-              (map f (cdr list)))))
-
-  (export map cadar caddr cdddr))
+  (export cadar caddr cdddr))
 
 ;;; core syntaces
 (define-library (picrin core-syntax)
@@ -374,9 +368,6 @@
       s
       (fold f (f (car xs) s) (cdr xs))))
 
-;;; FIXME forward declaration
-(define map #f)
-
 ;;; 6.2. Numbers
 
 (define (zero? n)
@@ -757,22 +748,6 @@
 
 ;;; 6.10 control features
 
-(set! map
-      (lambda (f list . lists)
-        (define (single-map f list)
-          (if (null? list)
-              '()
-              (cons (f (car list))
-                    (map f (cdr list)))))
-        (define (multiple-map f lists)
-          (if (any null? lists)
-              '()
-              (cons (apply f (single-map car lists))
-                    (multiple-map f (single-map cdr lists)))))
-        (if (null? lists)
-            (single-map f list)
-            (multiple-map f (cons list lists)))))
-
 (define (for-each f list . lists)
   (define (single-for-each f list)
     (if (null? list)
@@ -828,7 +803,7 @@
 	       (map (lambda (v) (vector-ref v n)) vs))
 	(loop (+ n 1))))))
 
-(export map for-each
+(export for-each
         string-map string-for-each
         vector-map vector-for-each)
 
diff --git a/src/proc.c b/src/proc.c
index 5d155e85..15317c83 100644
--- a/src/proc.c
+++ b/src/proc.c
@@ -85,21 +85,45 @@ static pic_value
 pic_proc_apply(pic_state *pic)
 {
   struct pic_proc *proc;
-  pic_value *args, v;
+  pic_value *args;
   size_t argc;
-  int i;
 
   pic_get_args(pic, "l*", &proc, &argc, &args);
 
   if (argc == 0) {
     pic_error(pic, "apply: wrong number of arguments");
   }
-  v = args[argc - 1];
-  for (i = argc - 2; i >= 0; --i) {
-    v = pic_cons(pic, args[i], v);
-  }
 
-  return pic_apply(pic, proc, v);
+  return pic_apply(pic, proc, pic_list_from_array(pic, argc, args));
+}
+
+static pic_value
+pic_proc_map(pic_state *pic)
+{
+  struct pic_proc *proc;
+  size_t argc;
+  pic_value *args;
+  int i;
+  pic_value cars, ret;
+
+  pic_get_args(pic, "l*", &proc, &argc, &args);
+
+  ret = pic_nil_value();
+  do {
+    cars = pic_nil_value();
+    for (i = argc - 1; i >= 0; --i) {
+      if (! pic_pair_p(args[i])) {
+        break;
+      }
+      cars = pic_cons(pic, pic_car(pic, args[i]), cars);
+      args[i] = pic_cdr(pic, args[i]);
+    }
+    if (i >= 0)
+      break;
+    ret = pic_cons(pic, pic_apply(pic, proc, cars), ret);
+  } while (1);
+
+  return pic_reverse(pic, ret);
 }
 
 void
@@ -107,4 +131,5 @@ pic_init_proc(pic_state *pic)
 {
   pic_defun(pic, "procedure?", pic_proc_proc_p);
   pic_defun(pic, "apply", pic_proc_apply);
+  pic_defun(pic, "map", pic_proc_map);
 }

From c539f889cda96f7de027e19c33fa0e267fe2a095 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 22:21:48 +0900
Subject: [PATCH 12/16] native implementatino of for-each

---
 piclib/built-in.scm | 20 +-------------------
 src/proc.c          | 29 +++++++++++++++++++++++++++++
 2 files changed, 30 insertions(+), 19 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index fbccc797..fc28f2df 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -748,23 +748,6 @@
 
 ;;; 6.10 control features
 
-(define (for-each f list . lists)
-  (define (single-for-each f list)
-    (if (null? list)
-	#f
-	(begin
-	  (f (car list))
-	  (single-for-each f (cdr list)))))
-  (define (multiple-for-each f lists)
-    (if (any null? lists)
-	#f
-	(begin
-	  (apply f (map car lists))
-	  (multiple-for-each f (map cdr lists)))))
-  (if (null? lists)
-      (single-for-each f list)
-      (multiple-for-each f (cons list lists))))
-
 (define (string-map f v . vs)
   (let* ((len (fold min (string-length v) (map string-length vs)))
 	 (vec (make-string len)))
@@ -803,8 +786,7 @@
 	       (map (lambda (v) (vector-ref v n)) vs))
 	(loop (+ n 1))))))
 
-(export for-each
-        string-map string-for-each
+(export string-map string-for-each
         vector-map vector-for-each)
 
 ;;; 6.13. Input and output
diff --git a/src/proc.c b/src/proc.c
index 15317c83..3509d479 100644
--- a/src/proc.c
+++ b/src/proc.c
@@ -126,10 +126,39 @@ pic_proc_map(pic_state *pic)
   return pic_reverse(pic, ret);
 }
 
+static pic_value
+pic_proc_for_each(pic_state *pic)
+{
+  struct pic_proc *proc;
+  size_t argc;
+  pic_value *args;
+  int i;
+  pic_value cars;
+
+  pic_get_args(pic, "l*", &proc, &argc, &args);
+
+  do {
+    cars = pic_nil_value();
+    for (i = argc - 1; i >= 0; --i) {
+      if (! pic_pair_p(args[i])) {
+        break;
+      }
+      cars = pic_cons(pic, pic_car(pic, args[i]), cars);
+      args[i] = pic_cdr(pic, args[i]);
+    }
+    if (i >= 0)
+      break;
+    pic_apply(pic, proc, cars);
+  } while (1);
+
+  return pic_none_value();
+}
+
 void
 pic_init_proc(pic_state *pic)
 {
   pic_defun(pic, "procedure?", pic_proc_proc_p);
   pic_defun(pic, "apply", pic_proc_apply);
   pic_defun(pic, "map", pic_proc_map);
+  pic_defun(pic, "for-each", pic_proc_for_each);
 }

From b3529112c0b44bea36e394a8e8cfc1028912f9ec Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 22:24:24 +0900
Subject: [PATCH 13/16] ignore gtag files

---
 .gitignore | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/.gitignore b/.gitignore
index 001b8be2..b23033c6 100644
--- a/.gitignore
+++ b/.gitignore
@@ -6,3 +6,6 @@ src/y.tab.h
 lib/libpicrin.so
 lib/libpicrin.so.dSYM
 .dir-locals.el
+GPATH
+GRTAGS
+GTAGS

From 5dd66cbcd14b67ded8e75cc7201dbb08753038cb Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 22:37:27 +0900
Subject: [PATCH 14/16] replace list-copy and make-list impls by scheme with
 ones by C

---
 include/picrin/pair.h |  2 ++
 piclib/built-in.scm   | 17 +--------------
 src/pair.c            | 48 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 51 insertions(+), 16 deletions(-)

diff --git a/include/picrin/pair.h b/include/picrin/pair.h
index 20b48dfd..fbfd64ad 100644
--- a/include/picrin/pair.h
+++ b/include/picrin/pair.h
@@ -16,6 +16,7 @@ pic_value pic_cdr(pic_state *, pic_value);
 bool pic_list_p(pic_state *, pic_value);
 pic_value pic_list(pic_state *, size_t, ...);
 pic_value pic_list_from_array(pic_state *, size_t, pic_value *);
+pic_value pic_make_list(pic_state *, int, pic_value);
 
 int pic_length(pic_state *, pic_value);
 pic_value pic_reverse(pic_state *, pic_value);
@@ -33,6 +34,7 @@ pic_value pic_cddr(pic_state *, pic_value);
 pic_value pic_list_tail(pic_state *, pic_value ,int);
 pic_value pic_list_ref(pic_state *, pic_value, int);
 void pic_list_set(pic_state *, pic_value, int, pic_value);
+pic_value pic_list_copy(pic_state *, pic_value);
 
 #if defined(__cplusplus)
 }
diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index fc28f2df..44295f27 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -445,20 +445,6 @@
 
 ;;; 6.4 Pairs and lists
 
-(define (make-list k . args)
-  (if (null? args)
-      (make-list k #f)
-      (if (zero? k)
-	  '()
-	  (cons (car args)
-		(make-list (- k 1) (car args))))))
-
-(define (list-copy obj)
-  (if (null? obj)
-      obj
-      (cons (car obj)
-	    (list-copy (cdr obj)))))
-
 (define (memq obj list)
   (if (null? list)
       #f
@@ -503,8 +489,7 @@
 	    (car list)
 	    (assoc obj (cdr list) compare)))))
 
-(export make-list list-copy
-        memq memv member
+(export memq memv member
         assq assv assoc)
 
 ;;; 6.5. Symbols
diff --git a/src/pair.c b/src/pair.c
index 3c1e8bbc..e30d3882 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -85,6 +85,20 @@ pic_list_from_array(pic_state *pic, size_t c, pic_value *vs)
   return pic_reverse(pic, v);
 }
 
+pic_value
+pic_make_list(pic_state *pic, int k, pic_value fill)
+{
+  pic_value list;
+  int i;
+
+  list = pic_nil_value();
+  for (i = 0; i < k; ++i) {
+    list = pic_cons(pic, fill, list);
+  }
+
+  return list;
+}
+
 int
 pic_length(pic_state *pic, pic_value obj)
 {
@@ -219,6 +233,17 @@ pic_list_set(pic_state *pic, pic_value list, int i, pic_value obj)
   pic_pair_ptr(pic_list_tail(pic, list, i))->car = obj;
 }
 
+pic_value
+pic_list_copy(pic_state *pic, pic_value obj)
+{
+  if (pic_pair_p(obj)) {
+    return pic_cons(pic, pic_car(pic, obj), pic_list_copy(pic, pic_cdr(pic, obj)));
+  }
+  else {
+    return obj;
+  }
+}
+
 static pic_value
 pic_pair_pair_p(pic_state *pic)
 {
@@ -347,6 +372,17 @@ pic_pair_list_p(pic_state *pic)
   return pic_bool_value(pic_list_p(pic, v));
 }
 
+static pic_value
+pic_pair_make_list(pic_state *pic)
+{
+  int i;
+  pic_value fill = pic_none_value();
+
+  pic_get_args(pic, "i|o", &i, &fill);
+
+  return pic_make_list(pic, i, fill);
+}
+
 static pic_value
 pic_pair_list(pic_state *pic)
 {
@@ -429,6 +465,16 @@ pic_pair_list_set(pic_state *pic)
   return pic_none_value();
 }
 
+static pic_value
+pic_pair_list_copy(pic_state *pic)
+{
+  pic_value obj;
+
+  pic_get_args(pic, "o", &obj);
+
+  return pic_list_copy(pic, obj);
+}
+
 void
 pic_init_pair(pic_state *pic)
 {
@@ -444,6 +490,7 @@ pic_init_pair(pic_state *pic)
   pic_defun(pic, "cddr", pic_pair_cddr);
   pic_defun(pic, "null?", pic_pair_null_p);
   pic_defun(pic, "list?", pic_pair_list_p);
+  pic_defun(pic, "make-list", pic_pair_make_list);
   pic_defun(pic, "list", pic_pair_list);
   pic_defun(pic, "length", pic_pair_length);
   pic_defun(pic, "append", pic_pair_append);
@@ -451,4 +498,5 @@ pic_init_pair(pic_state *pic)
   pic_defun(pic, "list-tail", pic_pair_list_tail);
   pic_defun(pic, "list-ref", pic_pair_list_ref);
   pic_defun(pic, "list-set!", pic_pair_list_set);
+  pic_defun(pic, "list-copy", pic_pair_list_copy);
 }

From 2f965fa809341e7715f744b24c3e4c140ba8a477 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 22:58:08 +0900
Subject: [PATCH 15/16] replace some number predicates with c imples

---
 piclib/built-in.scm | 27 +---------------------
 src/number.c        | 56 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 57 insertions(+), 26 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 44295f27..9d4bcf00 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -347,15 +347,6 @@
 (export make-parameter
         parameterize)
 
-(define (any pred list)
-  (if (null? list)
-      #f
-      ((lambda (it)
-	 (if it
-	     it
-	     (any pred (cdr list))))
-       (pred (car list)))))
-
 (define (every pred list)
   (if (null? list)
       #t
@@ -370,21 +361,6 @@
 
 ;;; 6.2. Numbers
 
-(define (zero? n)
-  (= n 0))
-
-(define (positive? x)
-  (> x 0))
-
-(define (negative? x)
-  (< x 0))
-
-(define (odd? n)
-  (= 0 (floor-remainder n 2)))
-
-(define (even? n)
-  (= 1 (floor-remainder n 2)))
-
 (define (min x . args)
   (let loop ((pivot x) (rest args))
     (if (null? rest)
@@ -429,8 +405,7 @@
 (define (lcm n m)
   (/ (* n m) (gcd n m)))
 
-(export zero? positive? negative?
-        odd? even? min max
+(export min max
         floor/ truncate/
         exact-integer-sqrt
         gcd lcm)
diff --git a/src/number.c b/src/number.c
index 74ddec4a..0adcbdbc 100644
--- a/src/number.c
+++ b/src/number.c
@@ -133,6 +133,56 @@ DEFINE_ARITH_CMP(>, gt)
 DEFINE_ARITH_CMP(<=, le)
 DEFINE_ARITH_CMP(>=, ge)
 
+static pic_value
+pic_number_zero_p(pic_state *pic)
+{
+  double f;
+
+  pic_get_args(pic, "f", &f);
+
+  return pic_bool_value(f == 0);
+}
+
+static pic_value
+pic_number_positive_p(pic_state *pic)
+{
+  double f;
+
+  pic_get_args(pic, "f", &f);
+
+  return pic_bool_value(f > 0);
+}
+
+static pic_value
+pic_number_negative_p(pic_state *pic)
+{
+  double f;
+
+  pic_get_args(pic, "f", &f);
+
+  return pic_bool_value(f < 0);
+}
+
+static pic_value
+pic_number_odd_p(pic_state *pic)
+{
+  int i;
+
+  pic_get_args(pic, "i", &i);
+
+  return pic_bool_value(i % 2 != 0);
+}
+
+static pic_value
+pic_number_even_p(pic_state *pic)
+{
+  int i;
+
+  pic_get_args(pic, "i", &i);
+
+  return pic_bool_value(i % 2 == 0);
+}
+
 #define DEFINE_ARITH_OP(op, name, unit)                         \
   static pic_value                                              \
   pic_number_##name(pic_state *pic)                             \
@@ -526,6 +576,12 @@ pic_init_number(pic_state *pic)
   pic_defun(pic, ">=", pic_number_ge);
   pic_gc_arena_restore(pic, ai);
 
+  pic_defun(pic, "zero?", pic_number_zero_p);
+  pic_defun(pic, "positive?", pic_number_positive_p);
+  pic_defun(pic, "negative?", pic_number_negative_p);
+  pic_defun(pic, "odd?", pic_number_odd_p);
+  pic_defun(pic, "even?", pic_number_even_p);
+
   pic_defun(pic, "+", pic_number_add);
   pic_defun(pic, "-", pic_number_sub);
   pic_defun(pic, "*", pic_number_mul);

From 95c53611976a9f494ff96725822dcf6533e1f498 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 22 Jan 2014 23:47:33 +0900
Subject: [PATCH 16/16] rewrite min/max/gcd/lcm with C

---
 piclib/built-in.scm |  35 +-----------
 src/number.c        | 136 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 138 insertions(+), 33 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 9d4bcf00..711cca48 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -361,18 +361,6 @@
 
 ;;; 6.2. Numbers
 
-(define (min x . args)
-  (let loop ((pivot x) (rest args))
-    (if (null? rest)
-	pivot
-	(loop (if (< pivot (car rest)) pivot (car rest)) (cdr rest)))))
-
-(define (max x . args)
-  (let loop ((pivot x) (rest args))
-    (if (null? rest)
-	pivot
-	(loop (if (> pivot (car rest)) pivot (car rest)) (cdr rest)))))
-
 (define (floor/ n m)
   (values (floor-quotient n m)
 	  (floor-remainder n m)))
@@ -388,27 +376,8 @@
   (let ((n (exact (floor (sqrt k)))))
     (values n (- k (square n)))))
 
-(define (gcd n m)
-  (if (negative? n)
-      (set! n (- n)))
-  (if (negative? m)
-      (set! m (- m)))
-  (if (> n m)
-      ((lambda (tmp)
-	 (set! n m)
-	 (set! m tmp))
-       n))
-  (if (zero? n)
-      m
-      (gcd (floor-remainder m n) n)))
-
-(define (lcm n m)
-  (/ (* n m) (gcd n m)))
-
-(export min max
-        floor/ truncate/
-        exact-integer-sqrt
-        gcd lcm)
+(export floor/ truncate/
+        exact-integer-sqrt)
 
 ;;; 6.3 Booleans
 
diff --git a/src/number.c b/src/number.c
index 0adcbdbc..321bab31 100644
--- a/src/number.c
+++ b/src/number.c
@@ -4,9 +4,28 @@
 
 #include <math.h>
 #include <limits.h>
+#include <stdlib.h>
 
 #include "picrin.h"
 
+static int
+gcd(int a, int b)
+{
+  if (a > b)
+    return gcd(b, a);
+  if (a < 0)
+    return gcd(-a, b);
+  if (a > 0)
+    return gcd(b % a, a);
+  return b;
+}
+
+static int
+lcm(int a, int b)
+{
+  return abs(a * b) / gcd(a, b);
+}
+
 static pic_value
 pic_number_real_p(pic_state *pic)
 {
@@ -183,6 +202,62 @@ pic_number_even_p(pic_state *pic)
   return pic_bool_value(i % 2 == 0);
 }
 
+static pic_value
+pic_number_max(pic_state *pic)
+{
+  size_t argc;
+  pic_value *argv;
+  int i;
+  double f;
+  bool e = true;
+
+  pic_get_args(pic, "*", &argc, &argv);
+
+  f = -INFINITY;
+  for (i = 0; i < argc; ++i) {
+    if (pic_int_p(argv[i])) {
+      f = fmax(f, pic_int(argv[i]));
+    }
+    else if (pic_float_p(argv[i])) {
+      e = false;
+      f = fmax(f, pic_float(argv[i]));
+    }
+    else {
+      pic_error(pic, "min: number required");
+    }
+  }
+
+  return e ? pic_int_value(f) : pic_float_value(f);
+}
+
+static pic_value
+pic_number_min(pic_state *pic)
+{
+  size_t argc;
+  pic_value *argv;
+  int i;
+  double f;
+  bool e = true;
+
+  pic_get_args(pic, "*", &argc, &argv);
+
+  f = INFINITY;
+  for (i = 0; i < argc; ++i) {
+    if (pic_int_p(argv[i])) {
+      f = fmin(f, pic_int(argv[i]));
+    }
+    else if (pic_float_p(argv[i])) {
+      e = false;
+      f = fmin(f, pic_float(argv[i]));
+    }
+    else {
+      pic_error(pic, "min: number required");
+    }
+  }
+
+  return e ? pic_int_value(f) : pic_float_value(f);
+}
+
 #define DEFINE_ARITH_OP(op, name, unit)                         \
   static pic_value                                              \
   pic_number_##name(pic_state *pic)                             \
@@ -333,6 +408,58 @@ pic_number_trunc_remainder(pic_state *pic)
   }
 }
 
+static pic_value
+pic_number_gcd(pic_state *pic)
+{
+  size_t argc;
+  pic_value *args;
+  int r;
+  bool e = true;
+
+  pic_get_args(pic, "*", &argc, &args);
+
+  r = 0;
+  while (argc-- > 0) {
+    if (pic_int_p(args[argc])) {
+      r = gcd(r, pic_int(args[argc]));
+    }
+    else if (pic_float_p(args[argc])) {
+      e = false;
+      r = gcd(r, pic_float(args[argc]));
+    }
+    else {
+      pic_error(pic, "gcd: number required");
+    }
+  }
+  return e ? pic_int_value(r) : pic_float_value(r);
+}
+
+static pic_value
+pic_number_lcm(pic_state *pic)
+{
+  size_t argc;
+  pic_value *args;
+  int r;
+  bool e = true;
+
+  pic_get_args(pic, "*", &argc, &args);
+
+  r = 1;
+  while (argc-- > 0) {
+    if (pic_int_p(args[argc])) {
+      r = lcm(r, pic_int(args[argc]));
+    }
+    else if (pic_float_p(args[argc])) {
+      e = false;
+      r = lcm(r, pic_float(args[argc]));
+    }
+    else {
+      pic_error(pic, "lcm: number required");
+    }
+  }
+  return e ? pic_int_value(r) : pic_float_value(r);
+}
+
 static pic_value
 pic_number_floor(pic_state *pic)
 {
@@ -581,6 +708,11 @@ pic_init_number(pic_state *pic)
   pic_defun(pic, "negative?", pic_number_negative_p);
   pic_defun(pic, "odd?", pic_number_odd_p);
   pic_defun(pic, "even?", pic_number_even_p);
+  pic_gc_arena_restore(pic, ai);
+
+  pic_defun(pic, "min", pic_number_min);
+  pic_defun(pic, "max", pic_number_max);
+  pic_gc_arena_restore(pic, ai);
 
   pic_defun(pic, "+", pic_number_add);
   pic_defun(pic, "-", pic_number_sub);
@@ -595,6 +727,10 @@ pic_init_number(pic_state *pic)
   pic_defun(pic, "truncate-remainder", pic_number_trunc_remainder);
   pic_gc_arena_restore(pic, ai);
 
+  pic_defun(pic, "gcd", pic_number_gcd);
+  pic_defun(pic, "lcm", pic_number_lcm);
+  pic_gc_arena_restore(pic, ai);
+
   pic_defun(pic, "floor", pic_number_floor);
   pic_defun(pic, "ceiling", pic_number_ceil);
   pic_defun(pic, "truncate", pic_number_trunc);