From 3716d99a02fbca437554bc48a82a180feef29558 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Wed, 13 Nov 2024 17:42:36 +0900 Subject: [PATCH] fast-path vector-map on two vectors --- lib/scheme/extras.scm | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm index 304db168..addb21a7 100644 --- a/lib/scheme/extras.scm +++ b/lib/scheme/extras.scm @@ -187,12 +187,22 @@ (lp (cdr ls) (+ i v-len))))))) (define (vector-map proc vec . lov) - (if (null? lov) + (cond + ((null? lov) + (let lp ((i (vector-length vec)) (res '())) + (if (zero? i) + (list->vector res) + (lp (- i 1) (cons (proc (vector-ref vec (- i 1))) res))))) + ((null? (cdr lov)) + (let ((vec2 (car lov))) (let lp ((i (vector-length vec)) (res '())) (if (zero? i) (list->vector res) - (lp (- i 1) (cons (proc (vector-ref vec (- i 1))) res)))) - (list->vector (apply map proc (map vector->list (cons vec lov)))))) + (lp (- i 1) + (cons (proc (vector-ref vec (- i 1)) (vector-ref vec2 (- i 1))) + res)))))) + (else + (list->vector (apply map proc (map vector->list (cons vec lov))))))) (define (vector-for-each proc vec . lov) (if (null? lov)