From 3330948a90b56ee8527d369f971b36fe68fff36a Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen 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 +;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen ;;; ;;; 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 +;;; +;;; 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 . + +(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