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