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