mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 20:00:19 +02:00
9084db993e
* benchmark-suite/benchmarks/continuations.bm: Increase "call/cc"
iterations from 300 to 12000.
* benchmark-suite/benchmarks/srfi-13.bm ("strings"): Increase "copy"
iterations from 1100 to 20000, and "pad" from 6800 to 34000.
* benchmark-suite/benchmarks/uniform-vector-read.bm
("uniform-vector-read!"): Increase "uniform-vector-write" iterations
from 500 to 4000, and "uniform-vector-read!" from 500 to 20000.
310 lines
11 KiB
Scheme
310 lines
11 KiB
Scheme
;;; coding: latin1 -*- mode: scheme; coding: latin-1; -*-
|
||
;;; srfi-13.bm
|
||
;;;
|
||
;;; Copyright (C) 2009 Free Software Foundation, Inc.
|
||
;;;
|
||
;;;
|
||
;;; This program is free software; you can redistribute it and/or
|
||
;;; modify it under the terms of the GNU Lesser General Public License
|
||
;;; as published by the Free Software Foundation; either version 3, or
|
||
;;; (at your option) any later version.
|
||
;;;
|
||
;;; This program 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 Lesser General Public License for more details.
|
||
;;;
|
||
;;; You should have received a copy of the GNU Lesser General Public
|
||
;;; License along with this software; see the file COPYING.LESSER. If
|
||
;;; not, write to the Free Software Foundation, Inc., 51 Franklin
|
||
;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||
|
||
(define-module (benchmarks strings)
|
||
:use-module (benchmark-suite lib))
|
||
|
||
(seed->random-state 1)
|
||
|
||
(define short-string "Hi")
|
||
(define medium-string
|
||
"ARMA virumque cano, Troiae qui primus ab oris
|
||
Italiam, fato profugus, Laviniaque venit")
|
||
(define long-string
|
||
(string-tabulate
|
||
(lambda (n) (integer->char (+ 32 (random 90))))
|
||
1000))
|
||
|
||
(define short-chlist (string->list short-string))
|
||
(define medium-chlist (string->list medium-string))
|
||
(define long-chlist (string->list long-string))
|
||
|
||
(define str1 (string-copy short-string))
|
||
(define str2 (string-copy medium-string))
|
||
(define str3 (string-copy long-string))
|
||
|
||
|
||
(with-benchmark-prefix "strings"
|
||
|
||
(with-benchmark-prefix "predicates"
|
||
|
||
(benchmark "string?" 1190000
|
||
(string? short-string)
|
||
(string? medium-string)
|
||
(string? long-string))
|
||
|
||
(benchmark "null?" 969000
|
||
(string-null? short-string)
|
||
(string-null? medium-string)
|
||
(string-null? long-string))
|
||
|
||
(benchmark "any" 94000
|
||
(string-any #\a short-string)
|
||
(string-any #\a medium-string)
|
||
(string-any #\a long-string))
|
||
|
||
(benchmark "every" 94000
|
||
(string-every #\a short-string)
|
||
(string-every #\a medium-string)
|
||
(string-every #\a long-string)))
|
||
|
||
(with-benchmark-prefix "constructors"
|
||
|
||
(benchmark "string" 5000
|
||
(apply string short-chlist)
|
||
(apply string medium-chlist)
|
||
(apply string long-chlist))
|
||
|
||
(benchmark "list->" 4500
|
||
(list->string short-chlist)
|
||
(list->string medium-chlist)
|
||
(list->string long-chlist))
|
||
|
||
(benchmark "reverse-list->" 5000
|
||
(reverse-list->string short-chlist)
|
||
(reverse-list->string medium-chlist)
|
||
(reverse-list->string long-chlist))
|
||
|
||
(benchmark "make" 22000
|
||
(make-string 250 #\x))
|
||
|
||
(benchmark "tabulate" 17000
|
||
(string-tabulate integer->char 250))
|
||
|
||
(benchmark "join" 5500
|
||
(string-join (list short-string medium-string long-string) "|" 'suffix)))
|
||
|
||
(with-benchmark-prefix "list/string"
|
||
(benchmark "->list" 7300
|
||
(string->list short-string)
|
||
(string->list medium-string)
|
||
(string->list long-string))
|
||
|
||
(benchmark "split" 60000
|
||
(string-split short-string #\a)
|
||
(string-split medium-string #\a)
|
||
(string-split long-string #\a)))
|
||
|
||
(with-benchmark-prefix "selection"
|
||
|
||
(benchmark "ref" 660
|
||
(let loop ((k 0))
|
||
(if (< k (string-length short-string))
|
||
(begin
|
||
(string-ref short-string k)
|
||
(loop (+ k 1)))))
|
||
(let loop ((k 0))
|
||
(if (< k (string-length medium-string))
|
||
(begin
|
||
(string-ref medium-string k)
|
||
(loop (+ k 1)))))
|
||
(let loop ((k 0))
|
||
(if (< k (string-length long-string))
|
||
(begin
|
||
(string-ref long-string k)
|
||
(loop (+ k 1))))))
|
||
|
||
(benchmark "copy" 20000
|
||
(string-copy short-string)
|
||
(string-copy medium-string)
|
||
(string-copy long-string)
|
||
(substring/copy short-string 0 1)
|
||
(substring/copy medium-string 10 20)
|
||
(substring/copy long-string 100 200))
|
||
|
||
(benchmark "pad" 34000
|
||
(string-pad short-string 100)
|
||
(string-pad medium-string 100)
|
||
(string-pad long-string 100))
|
||
|
||
(benchmark "trim trim-right trim-both" 60000
|
||
(string-trim short-string char-alphabetic?)
|
||
(string-trim medium-string char-alphabetic?)
|
||
(string-trim long-string char-alphabetic?)
|
||
(string-trim-right short-string char-alphabetic?)
|
||
(string-trim-right medium-string char-alphabetic?)
|
||
(string-trim-right long-string char-alphabetic?)
|
||
(string-trim-both short-string char-alphabetic?)
|
||
(string-trim-both medium-string char-alphabetic?)
|
||
(string-trim-both long-string char-alphabetic?)))
|
||
|
||
(with-benchmark-prefix "modification"
|
||
|
||
(set! str1 (string-copy short-string))
|
||
(set! str2 (string-copy medium-string))
|
||
(set! str3 (string-copy long-string))
|
||
|
||
(benchmark "set!" 3000
|
||
(let loop ((k 1))
|
||
(if (< k (string-length short-string))
|
||
(begin
|
||
(string-set! str1 k #\x)
|
||
(loop (+ k 1)))))
|
||
(let loop ((k 20))
|
||
(if (< k (string-length medium-string))
|
||
(begin
|
||
(string-set! str2 k #\x)
|
||
(loop (+ k 1)))))
|
||
(let loop ((k 900))
|
||
(if (< k (string-length long-string))
|
||
(begin
|
||
(string-set! str3 k #\x)
|
||
(loop (+ k 1))))))
|
||
|
||
(set! str1 (string-copy short-string))
|
||
(set! str2 (string-copy medium-string))
|
||
(set! str3 (string-copy long-string))
|
||
|
||
(benchmark "sub-move!" 230000
|
||
(substring-move! short-string 0 2 str2 10)
|
||
(substring-move! medium-string 10 20 str3 20))
|
||
|
||
(set! str1 (string-copy short-string))
|
||
(set! str2 (string-copy medium-string))
|
||
(set! str3 (string-copy long-string))
|
||
|
||
(benchmark "fill!" 230000
|
||
(string-fill! str1 #\y 0 1)
|
||
(string-fill! str2 #\y 10 20)
|
||
(string-fill! str3 #\y 20 30))
|
||
|
||
(with-benchmark-prefix "comparison"
|
||
|
||
(benchmark "compare compare-ci" 140000
|
||
(string-compare short-string medium-string string<? string=? string>?)
|
||
(string-compare long-string medium-string string<? string=? string>?)
|
||
(string-compare-ci short-string medium-string string<? string=? string>?)
|
||
(string-compare-ci long-string medium-string string<? string=? string>?))
|
||
|
||
(benchmark "hash hash-ci" 1000
|
||
(string-hash short-string)
|
||
(string-hash medium-string)
|
||
(string-hash long-string)
|
||
(string-hash-ci short-string)
|
||
(string-hash-ci medium-string)
|
||
(string-hash-ci long-string))))
|
||
|
||
(with-benchmark-prefix "searching" 20000
|
||
|
||
(benchmark "prefix-length suffix-length" 270
|
||
(string-prefix-length short-string
|
||
(string-append short-string medium-string))
|
||
(string-prefix-length long-string
|
||
(string-append long-string medium-string))
|
||
(string-suffix-length short-string
|
||
(string-append medium-string short-string))
|
||
(string-suffix-length long-string
|
||
(string-append medium-string long-string))
|
||
(string-prefix-length-ci short-string
|
||
(string-append short-string medium-string))
|
||
(string-prefix-length-ci long-string
|
||
(string-append long-string medium-string))
|
||
(string-suffix-length-ci short-string
|
||
(string-append medium-string short-string))
|
||
(string-suffix-length-ci long-string
|
||
(string-append medium-string long-string)))
|
||
|
||
(benchmark "prefix? suffix?" 270
|
||
(string-prefix? short-string
|
||
(string-append short-string medium-string))
|
||
(string-prefix? long-string
|
||
(string-append long-string medium-string))
|
||
(string-suffix? short-string
|
||
(string-append medium-string short-string))
|
||
(string-suffix? long-string
|
||
(string-append medium-string long-string))
|
||
(string-prefix-ci? short-string
|
||
(string-append short-string medium-string))
|
||
(string-prefix-ci? long-string
|
||
(string-append long-string medium-string))
|
||
(string-suffix-ci? short-string
|
||
(string-append medium-string short-string))
|
||
(string-suffix-ci? long-string
|
||
(string-append medium-string long-string)))
|
||
|
||
(benchmark "index index-right rindex" 100000
|
||
(string-index short-string #\T)
|
||
(string-index medium-string #\T)
|
||
(string-index long-string #\T)
|
||
(string-index-right short-string #\T)
|
||
(string-index-right medium-string #\T)
|
||
(string-index-right long-string #\T)
|
||
(string-rindex short-string #\T)
|
||
(string-rindex medium-string #\T)
|
||
(string-rindex long-string #\T))
|
||
|
||
(benchmark "skip skip-right?" 100000
|
||
(string-skip short-string char-alphabetic?)
|
||
(string-skip medium-string char-alphabetic?)
|
||
(string-skip long-string char-alphabetic?)
|
||
(string-skip-right short-string char-alphabetic?)
|
||
(string-skip-right medium-string char-alphabetic?)
|
||
(string-skip-right long-string char-alphabetic?))
|
||
|
||
(benchmark "count" 10000
|
||
(string-count short-string char-alphabetic?)
|
||
(string-count medium-string char-alphabetic?)
|
||
(string-count long-string char-alphabetic?))
|
||
|
||
(benchmark "contains contains-ci" 34000
|
||
(string-contains short-string short-string)
|
||
(string-contains medium-string (substring medium-string 10 15))
|
||
(string-contains long-string (substring long-string 100 130))
|
||
(string-contains-ci short-string short-string)
|
||
(string-contains-ci medium-string (substring medium-string 10 15))
|
||
(string-contains-ci long-string (substring long-string 100 130)))
|
||
|
||
(set! str1 (string-copy short-string))
|
||
(set! str2 (string-copy medium-string))
|
||
(set! str3 (string-copy long-string))
|
||
|
||
(benchmark "upcase downcase upcase! downcase!" 600
|
||
(string-upcase short-string)
|
||
(string-upcase medium-string)
|
||
(string-upcase long-string)
|
||
(string-downcase short-string)
|
||
(string-downcase medium-string)
|
||
(string-downcase long-string)
|
||
(string-upcase! str1 0 1)
|
||
(string-upcase! str2 10 20)
|
||
(string-upcase! str3 100 130)
|
||
(string-downcase! str1 0 1)
|
||
(string-downcase! str2 10 20)
|
||
(string-downcase! str3 100 130)))
|
||
|
||
(with-benchmark-prefix "readers"
|
||
|
||
(benchmark "read token, method 1" 1200
|
||
(let ((buf (make-string 512)))
|
||
(let loop ((i 0))
|
||
(if (< i 512)
|
||
(begin
|
||
(string-set! buf i #\x)
|
||
(loop (+ i 1)))
|
||
buf))))
|
||
|
||
(benchmark "read token, method 2" 1200
|
||
(let ((lst '()))
|
||
(let loop ((i 0))
|
||
(set! lst (append! lst (list #\x)))
|
||
(if (< i 512)
|
||
(loop (+ i 1))
|
||
(list->string lst)))))))
|