core: Optimize vector-map, vector-for-each.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 20 Apr 2018 11:06:00 +0000 (13:06 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 20 Apr 2018 11:06:00 +0000 (13:06 +0200)
* 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
make.scm
module/srfi/srfi-43.mes
tests/srfi-43.test [new file with mode: 0755]
tests/srfi-43.test-guile [new symlink]

index 8e5c9e9579079a47d034e6feb57c60351ac326b9..cfdb61423b9206e9702908250ab0978b3e9464d5 100755 (executable)
--- 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
index 2c5b7fc844468e8feb1aaa03b81e70712543e18c..2ed2c7cd69802b38074ae0eb0e6c61d302231e18 100755 (executable)
--- 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"
index d7c84f7f5d6423ca37fc639ec53edc2701bbe155..df3c3a6a32c5c5370d2be3ea80e78137a7487fe8 100644 (file)
@@ -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.
 ;;;
 ;;; 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 (executable)
index 0000000..e46cd00
--- /dev/null
@@ -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 (symlink)
index 0000000..5631f4a
--- /dev/null
@@ -0,0 +1 @@
+base.test-guile
\ No newline at end of file