From 3330948a90b56ee8527d369f971b36fe68fff36a Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Fri, 20 Apr 2018 13:06:00 +0200
Subject: [PATCH] core: Optimize vector-map, vector-for-each.

* module/srfi/srfi-43.mes (vector-map): Optimize.
  (vector-for-each): Optimize.
* tests/srfi-43.test: New file.
* tests/srfi-43.test-guile: New file.
* check.sh (tests): Add it.
* make.scm (mes-tests): Add it.
---
 check.sh                 |  1 +
 make.scm                 |  1 +
 module/srfi/srfi-43.mes  | 17 +++++++++++---
 tests/srfi-43.test       | 50 ++++++++++++++++++++++++++++++++++++++++
 tests/srfi-43.test-guile |  1 +
 5 files changed, 67 insertions(+), 3 deletions(-)
 create mode 100755 tests/srfi-43.test
 create mode 120000 tests/srfi-43.test-guile

diff --git a/check.sh b/check.sh
index 8e5c9e95..cfdb6142 100755
--- a/check.sh
+++ b/check.sh
@@ -40,6 +40,7 @@ tests/vector.test
 tests/srfi-1.test
 tests/srfi-13.test
 tests/srfi-14.test
+tests/srfi-43.test
 tests/optargs.test
 tests/fluids.test
 tests/catch.test
diff --git a/make.scm b/make.scm
index 2c5b7fc8..2ed2c7cd 100755
--- a/make.scm
+++ b/make.scm
@@ -469,6 +469,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
     "tests/srfi-13.test"
     "tests/srfi-14.test"
     "tests/srfi-16.test"
+    "tests/srfi-43.test"
     "tests/optargs.test"
     "tests/fluids.test"
     "tests/catch.test"
diff --git a/module/srfi/srfi-43.mes b/module/srfi/srfi-43.mes
index d7c84f7f..df3c3a6a 100644
--- a/module/srfi/srfi-43.mes
+++ b/module/srfi/srfi-43.mes
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -25,7 +25,18 @@
 ;;; Code:
 
 (define (vector-map f v)
-  (list->vector (map f (iota (vector-length v)) (vector->list v))))
+  (let* ((k (vector-length v))
+         (n (core:make-vector k)))
+    (let loop ((i 0))
+      (if (= i k) n
+          (begin
+            (vector-set! n i (f i (vector-ref v i)))
+            (loop (+ i 1)))))))
 
 (define (vector-for-each f v)
-  (for-each f (iota (vector-length v)) (vector->list v)))
+  (let ((k (vector-length v)))
+    (let loop ((i 0))
+      (if (< i k)
+          (begin
+            (f i (vector-ref v i))
+            (loop (+ i 1)))))))
diff --git a/tests/srfi-43.test b/tests/srfi-43.test
new file mode 100755
index 00000000..e46cd005
--- /dev/null
+++ b/tests/srfi-43.test
@@ -0,0 +1,50 @@
+#! /bin/sh
+# -*-scheme-*-
+MES=${MES-$(dirname $0)/../src/mes}
+#export MES_ARENA=${MES_ARENA-40000}
+$MES $MES_FLAGS "$@" < $0
+exit $?
+!#
+
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(cond-expand
+ (mes)
+ (guile (use-modules (srfi srfi-43))))
+
+(mes-use-module (srfi srfi-43))
+(mes-use-module (mes test))
+
+(pass-if "first dummy" #t)
+(pass-if-not "second dummy" #f)
+
+(pass-if-equal "vector-map"
+               #(0 2 4)
+               (vector-map (lambda (i e) (+ i e)) #(0 1 2)))
+
+(pass-if-equal "vector-for-each"
+               4
+               (let ((g 0))
+                 (vector-for-each (lambda (i e) (set! g (+ i e))) #(0 1 2))
+                 g))
+
+(result 'report)
+
diff --git a/tests/srfi-43.test-guile b/tests/srfi-43.test-guile
new file mode 120000
index 00000000..5631f4a9
--- /dev/null
+++ b/tests/srfi-43.test-guile
@@ -0,0 +1 @@
+base.test-guile
\ No newline at end of file