Hi there!
I was spelunking through the guile source tree and found (rnrs base). The
vector-map and vector-for-each in there are horribly inefficient. They are
doing (list->vector (apply map PROC (map vector->list vectors))), which means
it spends quite some time checking for circular references.
This fixes that. The speedup is surprisingly small, considering we pass through
the elements 2 fewer times and don't chase pointers through memory trying to
find cycles. Anywhere from 30 to 300% depending on how the stars are aligned on
things like (vector-map + vec vec)
One potential speedup we could do is using eq? to compare numbers, but I don't
know how well fixnums in guile overlap size_t, regardless of how realistic such
a limitation would be. If I change the behaviour of vector-map to go
back-to-front (order is unspecified in r6rs) we can easily do (eq? -1 index) as
a stop condition to avoid any eventual overhead of type checking with =. (If
those are not elided, which I suspect might be the case. ). I did not look at
that, since I have too little computer time these days.
As an added bonus, this speeds up quicksort.scm in ecraven's benchmarks by a
little.
--
Linus Björnstam
From 6dc71eeec1b0efad9be23c6f72323cdc58caf26b Mon Sep 17 00:00:00 2001
From: Linus <[email protected]>
Date: Wed, 17 Feb 2021 22:28:19 +0100
Subject: [PATCH] Write a proper vector-map and vector-for-each for (rnrs base)
* module/rnrs/base.scm (vector-map vector-for-each): Rewrite to not be slow.
---
module/rnrs/base.scm | 80 +++++++++++++++++++++++++++++++++++++++++---
1 file changed, 76 insertions(+), 4 deletions(-)
diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index 9205016bd..cd2327e49 100644
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -231,10 +231,82 @@
(and (rational-valued? x)
(= x (floor (real-part x)))))
- (define (vector-for-each proc . vecs)
- (apply for-each (cons proc (map vector->list vecs))))
- (define (vector-map proc . vecs)
- (list->vector (apply map (cons proc (map vector->list vecs)))))
+ ;; Auxiliary procedure for vector-map and vector-for-each
+ (define (vector-lengths who . vs)
+ (let ((lengths (map vector-length vs)))
+ (unless (apply = lengths)
+ (apply error
+ (string-append (symbol->string who)
+ ": Vectors of uneven length.")
+ vs))
+ (car lengths)))
+
+(define vector-map
+ (case-lambda
+ "(vector-map f vec2 vec2 ...) -> vector
+
+Return a new vector of the size of the vector arguments, which
+must be of equal length. Each element at index @var{i} of the new
+vector is mapped from the old vectors by @code{(f (vector-ref vec1 i)
+(vector-ref vec2 i) ...)}. The dynamic order of application of
+@var{f} is unspecified."
+ ((f v)
+ (let* ((len (vector-length v))
+ (result (make-vector len)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! result i (f (vector-ref v i)))
+ (loop (+ i 1))))
+ result))
+ ((f v1 v2)
+ (let* ((len (vector-lengths 'vector-map v1 v2))
+ (result (make-vector len)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! result
+ i
+ (f (vector-ref v1 i) (vector-ref v2 i)))
+ (loop (+ i 1)))
+ result)))
+ ((f v . vs)
+ (let* ((vs (cons v vs))
+ (len (apply vector-lengths 'vector-map vs))
+ (result (make-vector len)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (vector-set! result
+ i
+ (apply f (map (lambda (v) (vector-ref v i)) vs)))
+ (loop (+ i 1))))
+ result))))
+
+(define vector-for-each
+ (case-lambda
+ "(vector-for-each f vec1 vec2 ...) -> unspecified
+
+Call @code{(f (vector-ref vec1 i) (vector-ref vec2 i) ...)} for each index
+ in the provided vectors, which have to be of equal length. The iteration
+is strictly left-to-right."
+ ((f v)
+ (let ((len (vector-length v)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (f (vector-ref v i))
+ (loop (+ i 1))))))
+ ((f v1 v2)
+ (let ((len (vector-lengths 'vector-for-each v1 v2)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (f (vector-ref v1 i) (vector-ref v2 i))
+ (loop (+ i 1))))))
+ ((f v . vs)
+ (let* ((vs (cons v vs))
+ (len (apply vector-lengths 'vector-for-each vs)))
+ (let loop ((i 0))
+ (unless (= i len)
+ (apply f (map (lambda (v) (vector-ref v i)) vs))
+ (loop (+ i 1))))))))
+
(define-syntax define-proxy
(syntax-rules (@)
--
2.25.1
