diff options
author | Andy Wingo <wingo@pobox.com> | 2011-05-06 00:18:52 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-05-06 00:18:52 +0200 |
commit | 5eb75b5de08ea8eb86a4760e1454460b61b4bccc (patch) | |
tree | 55efc5ec0ed5bf42cfafd7249637d96cb4818ef3 /module/ice-9/psyntax.scm | |
parent | 891a1851a1e0e47560cf99cf76e9478d77e1a7db (diff) | |
parent | a2a6c0e319b5c146c484cb1fe8ffc9b14b9a9876 (diff) | |
download | guile-5eb75b5de08ea8eb86a4760e1454460b61b4bccc.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Diffstat (limited to 'module/ice-9/psyntax.scm')
-rw-r--r-- | module/ice-9/psyntax.scm | 27 |
1 files changed, 7 insertions, 20 deletions
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 85ceb13c2..5380ba787 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -156,25 +156,6 @@ (set-current-module (resolve-module '(guile)))) (let () - ;; Private version of and-map that handles multiple lists. - (define and-map* - (lambda (f first . rest) - (or (null? first) - (if (null? rest) - (let andmap ((first first)) - (let ((x (car first)) (first (cdr first))) - (if (null? first) - (f x) - (and (f x) (andmap first))))) - (let andmap ((first first) (rest rest)) - (let ((x (car first)) - (xr (map car rest)) - (first (cdr first)) - (rest (map cdr rest))) - (if (null? first) - (apply f x xr) - (and (apply f x xr) (andmap first rest))))))))) - (define-syntax define-expansion-constructors (lambda (x) (syntax-case x () @@ -1747,7 +1728,13 @@ ((vector? x) (let ((old (vector->list x))) (let ((new (map f old))) - (if (and-map* eq? old new) x (list->vector new))))) + ;; inlined and-map with two args + (let lp ((l1 old) (l2 new)) + (if (null? l1) + x + (if (eq? (car l1) (car l2)) + (lp (cdr l1) (cdr l2)) + (list->vector new))))))) (else x)))))) ;; lexical variables |