diff options
author | Andy Wingo <wingo@pobox.com> | 2014-03-30 22:28:07 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-03-31 18:21:04 +0200 |
commit | 4926024cfbd9d0a428880a919b6e5a394b4a304d (patch) | |
tree | 46cc428574e55a9ac6c6333d0652485015acac1e | |
parent | de3cbadcc08f7f46bab0d91d4dcc5bac2f64613f (diff) | |
download | guile-4926024cfbd9d0a428880a919b6e5a394b4a304d.tar.gz |
Simplify boot-9 and srfi-1 map
* module/ice-9/boot-9.scm (map):
* module/srfi/srfi-1.scm (map): Simplify the implementations to check
for list? beforehand. It's faster, and it will be needed if we decide
to go recursive.
-rw-r--r-- | module/ice-9/boot-9.scm | 65 | ||||
-rw-r--r-- | module/srfi/srfi-1.scm | 19 |
2 files changed, 20 insertions, 64 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 4d5d603ae..8bc8e5319 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -837,58 +837,23 @@ for key @var{k}, then invoke @var{thunk}." (define map (case-lambda ((f l) - (let map1 ((hare l) (tortoise l) (move? #f) (out '())) - (if (pair? hare) - (if move? - (if (eq? tortoise hare) - (scm-error 'wrong-type-arg "map" "Circular list: ~S" - (list l) #f) - (map1 (cdr hare) (cdr tortoise) #f - (cons (f (car hare)) out))) - (map1 (cdr hare) tortoise #t - (cons (f (car hare)) out))) - (if (null? hare) - (reverse! out) - (scm-error 'wrong-type-arg "map" "Not a list: ~S" - (list l) #f))))) + (unless (list? l) + (scm-error 'wrong-type-arg "map" "Not a list: ~S" + (list l) #f)) + (let map1 ((l l) (out '())) + (if (pair? l) + (map1 (cdr l) (cons (f (car l)) out)) + (reverse! out)))) ((f l1 l2) - (let map2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f) (out '())) - (cond - ((pair? h1) - (cond - ((not (pair? h2)) - (scm-error 'wrong-type-arg "map" - (if (list? h2) - "List of wrong length: ~S" - "Not a list: ~S") - (list l2) #f)) - ((not move?) - (map2 (cdr h1) (cdr h2) t1 t2 #t - (cons (f (car h1) (car h2)) out))) - ((eq? t1 h1) - (scm-error 'wrong-type-arg "map" "Circular list: ~S" - (list l1) #f)) - ((eq? t2 h2) - (scm-error 'wrong-type-arg "map" "Circular list: ~S" - (list l2) #f)) - (else - (map2 (cdr h1) (cdr h2) (cdr t1) (cdr t2) #f - (cons (f (car h1) (car h2)) out))))) - - ((and (null? h1) (null? h2)) - (reverse! out)) - - ((null? h1) - (scm-error 'wrong-type-arg "map" - (if (list? h2) - "List of wrong length: ~S" - "Not a list: ~S") - (list l2) #f)) - (else - (scm-error 'wrong-type-arg "map" - "Not a list: ~S" - (list l1) #f))))) + (unless (= (length l1) (length l2)) + (scm-error 'wrong-type-arg "map" "List of wrong length: ~S" + (list l2) #f)) + + (let map2 ((l1 l1) (l2 l2) (out '())) + (if (pair? l1) + (map2 (cdr l1) (cdr l2) (cons (f (car l1) (car l2)) out)) + (reverse! out)))) ((f l1 . rest) (let ((len (length l1))) diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index c7c1f8dee..919d51274 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -566,20 +566,11 @@ has just one element then that's the return value." (case-lambda ((f l) (check-arg procedure? f map) - (let map1 ((hare l) (tortoise l) (move? #f) (out '())) - (if (pair? hare) - (if move? - (if (eq? tortoise hare) - (scm-error 'wrong-type-arg "map" "Circular list: ~S" - (list l) #f) - (map1 (cdr hare) (cdr tortoise) #f - (cons (f (car hare)) out))) - (map1 (cdr hare) tortoise #t - (cons (f (car hare)) out))) - (if (null? hare) - (reverse! out) - (scm-error 'wrong-type-arg "map" "Not a list: ~S" - (list l) #f))))) + (check-arg list? l map) + (let map1 ((in l) (out '())) + (if (pair? in) + (map1 (cdr in) (cons (f (car in)) out)) + (reverse! out)))) ((f l1 . rest) (check-arg procedure? f map) |