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] 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);