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

@@ -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

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"

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)))))))

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)
+

tests/srfi-43.test-guile

@@ -0,0 +1 @@
+base.test-guile