replace list-copy and make-list impls by scheme with ones by C

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)
 }

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

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