benchmark-suite/benchmarks/srfi-13.bm

   1 ;;; coding: latin1 -*- mode: scheme; coding: latin-1; -*-
   2 ;;; srfi-13.bm
   3 ;;;
   4 ;;; Copyright (C) 2009  Free Software Foundation, Inc.
   5 ;;;
   6 ;;;
   7 ;;; This program is free software; you can redistribute it and/or
   8 ;;; modify it under the terms of the GNU Lesser General Public License
   9 ;;; as published by the Free Software Foundation; either version 3, or
  10 ;;; (at your option) any later version.
  11 ;;;
  12 ;;; This program is distributed in the hope that it will be useful,
  13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU Lesser General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU Lesser General Public
  18 ;;; License along with this software; see the file COPYING.LESSER.  If
  19 ;;; not, write to the Free Software Foundation, Inc., 51 Franklin
  20 ;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
  21
  22 (define-module (benchmarks strings)
  23   :use-module (benchmark-suite lib))
  24
  25 (seed->random-state 1)
  26
  27 (define short-string "Hi")
  28 (define medium-string
  29 "ARMA virumque cano, Troiae qui primus ab oris
  30 Italiam, fato profugus, Laviniaque venit")
  31 (define long-string
  32   (string-tabulate
  33    (lambda (n) (integer->char (+ 32 (random 90))))
  34    1000))
  35
  36 (define short-chlist (string->list short-string))
  37 (define medium-chlist (string->list medium-string))
  38 (define long-chlist (string->list long-string))
  39
  40 (define str1 (string-copy short-string))
  41 (define str2 (string-copy medium-string))
  42 (define str3 (string-copy long-string))
  43
  44 \f
  45 (with-benchmark-prefix "strings"
  46
  47   (with-benchmark-prefix "predicates"
  48
  49     (benchmark "string?" 1190000
  50       (string? short-string)
  51       (string? medium-string)
  52       (string? long-string))
  53
  54     (benchmark "null?" 969000
  55       (string-null? short-string)
  56       (string-null? medium-string)
  57       (string-null? long-string))
  58
  59     (benchmark "any" 94000
  60       (string-any #\a short-string)
  61       (string-any #\a medium-string)
  62       (string-any #\a long-string))
  63
  64     (benchmark "every" 94000
  65       (string-every #\a short-string)
  66       (string-every #\a medium-string)
  67       (string-every #\a long-string)))
  68
  69   (with-benchmark-prefix "constructors"
  70
  71     (benchmark "string" 5000
  72       (apply string short-chlist)
  73       (apply string medium-chlist)
  74       (apply string long-chlist))
  75
  76     (benchmark "list->" 4500
  77       (list->string short-chlist)
  78       (list->string medium-chlist)
  79       (list->string long-chlist))
  80
  81     (benchmark "reverse-list->" 5000
  82       (reverse-list->string short-chlist)
  83       (reverse-list->string medium-chlist)
  84       (reverse-list->string long-chlist))
  85
  86     (benchmark "make" 22000
  87       (make-string 250 #\x))
  88
  89     (benchmark "tabulate" 17000
  90       (string-tabulate integer->char 250))
  91
  92     (benchmark "join" 5500
  93       (string-join (list short-string medium-string long-string) "|" 'suffix)))
  94
  95   (with-benchmark-prefix "list/string"
  96     (benchmark "->list" 7300
  97       (string->list short-string)
  98       (string->list medium-string)
  99       (string->list long-string))
 100
 101     (benchmark "split" 60000
 102       (string-split short-string #\a)
 103       (string-split medium-string #\a)
 104       (string-split long-string #\a)))
 105
 106   (with-benchmark-prefix "selection"
 107
 108     (benchmark "ref" 660
 109       (let loop ((k 0))
 110         (if (< k (string-length short-string))
 111             (begin
 112               (string-ref short-string k)
 113               (loop (+ k 1)))))
 114       (let loop ((k 0))
 115         (if (< k (string-length medium-string))
 116             (begin
 117               (string-ref medium-string k)
 118               (loop (+ k 1)))))
 119       (let loop ((k 0))
 120         (if (< k (string-length long-string))
 121             (begin
 122               (string-ref long-string k)
 123               (loop (+ k 1))))))
 124
 125     (benchmark "copy" 20000
 126       (string-copy short-string)
 127       (string-copy medium-string)
 128       (string-copy long-string)
 129       (substring/copy short-string 0 1)
 130       (substring/copy medium-string 10 20)
 131       (substring/copy long-string 100 200))
 132
 133     (benchmark "pad" 34000
 134       (string-pad short-string 100)
 135       (string-pad medium-string 100)
 136       (string-pad long-string 100))
 137
 138     (benchmark "trim trim-right trim-both" 60000
 139       (string-trim short-string char-alphabetic?)
 140       (string-trim medium-string char-alphabetic?)
 141       (string-trim long-string char-alphabetic?)
 142       (string-trim-right short-string char-alphabetic?)
 143       (string-trim-right medium-string char-alphabetic?)
 144       (string-trim-right long-string char-alphabetic?)
 145       (string-trim-both short-string char-alphabetic?)
 146       (string-trim-both medium-string char-alphabetic?)
 147       (string-trim-both long-string char-alphabetic?)))
 148
 149   (with-benchmark-prefix "modification"
 150
 151     (set! str1 (string-copy short-string))
 152     (set! str2 (string-copy medium-string))
 153     (set! str3 (string-copy long-string))
 154
 155     (benchmark "set!" 3000
 156       (let loop ((k 1))
 157         (if (< k (string-length short-string))
 158             (begin
 159               (string-set! str1 k #\x)
 160               (loop (+ k 1)))))
 161       (let loop ((k 20))
 162         (if (< k (string-length medium-string))
 163             (begin
 164               (string-set! str2 k #\x)
 165               (loop (+ k 1)))))
 166       (let loop ((k 900))
 167         (if (< k (string-length long-string))
 168             (begin
 169               (string-set! str3 k #\x)
 170               (loop (+ k 1))))))
 171
 172     (set! str1 (string-copy short-string))
 173     (set! str2 (string-copy medium-string))
 174     (set! str3 (string-copy long-string))
 175
 176     (benchmark "sub-move!" 230000
 177       (substring-move! short-string 0 2 str2 10)
 178       (substring-move! medium-string 10 20 str3 20))
 179
 180     (set! str1 (string-copy short-string))
 181     (set! str2 (string-copy medium-string))
 182     (set! str3 (string-copy long-string))
 183
 184     (benchmark "fill!" 230000
 185       (string-fill! str1 #\y 0 1)
 186       (string-fill! str2 #\y 10 20)
 187       (string-fill! str3 #\y 20 30))
 188
 189   (with-benchmark-prefix "comparison"
 190
 191     (benchmark "compare compare-ci" 140000
 192       (string-compare short-string medium-string string<? string=? string>?)
 193       (string-compare long-string medium-string string<? string=? string>?)
 194       (string-compare-ci short-string medium-string string<? string=? string>?)
 195       (string-compare-ci long-string medium-string string<? string=? string>?))
 196
 197     (benchmark "hash hash-ci" 1000
 198       (string-hash short-string)
 199       (string-hash medium-string)
 200       (string-hash long-string)
 201       (string-hash-ci short-string)
 202       (string-hash-ci medium-string)
 203       (string-hash-ci long-string))))
 204
 205   (with-benchmark-prefix "searching" 20000
 206
 207     (benchmark "prefix-length suffix-length" 270
 208       (string-prefix-length short-string
 209                             (string-append short-string medium-string))
 210       (string-prefix-length long-string
 211                             (string-append long-string medium-string))
 212       (string-suffix-length short-string
 213                             (string-append medium-string short-string))
 214       (string-suffix-length long-string
 215                             (string-append medium-string long-string))
 216       (string-prefix-length-ci short-string
 217                             (string-append short-string medium-string))
 218       (string-prefix-length-ci long-string
 219                             (string-append long-string medium-string))
 220       (string-suffix-length-ci short-string
 221                             (string-append medium-string short-string))
 222       (string-suffix-length-ci long-string
 223                             (string-append medium-string long-string)))
 224
 225     (benchmark "prefix? suffix?" 270
 226       (string-prefix? short-string
 227                             (string-append short-string medium-string))
 228       (string-prefix? long-string
 229                             (string-append long-string medium-string))
 230       (string-suffix? short-string
 231                             (string-append medium-string short-string))
 232       (string-suffix? long-string
 233                             (string-append medium-string long-string))
 234       (string-prefix-ci? short-string
 235                             (string-append short-string medium-string))
 236       (string-prefix-ci? long-string
 237                             (string-append long-string medium-string))
 238       (string-suffix-ci? short-string
 239                             (string-append medium-string short-string))
 240       (string-suffix-ci? long-string
 241                             (string-append medium-string long-string)))
 242
 243     (benchmark "index index-right rindex" 100000
 244       (string-index short-string #\T)
 245       (string-index medium-string #\T)
 246       (string-index long-string #\T)
 247       (string-index-right short-string #\T)
 248       (string-index-right medium-string #\T)
 249       (string-index-right long-string #\T)
 250       (string-rindex short-string #\T)
 251       (string-rindex medium-string #\T)
 252       (string-rindex long-string #\T))
 253
 254     (benchmark "skip skip-right?" 100000
 255       (string-skip short-string char-alphabetic?)
 256       (string-skip medium-string char-alphabetic?)
 257       (string-skip long-string char-alphabetic?)
 258       (string-skip-right short-string char-alphabetic?)
 259       (string-skip-right medium-string char-alphabetic?)
 260       (string-skip-right long-string char-alphabetic?))
 261
 262     (benchmark "count" 10000
 263       (string-count short-string char-alphabetic?)
 264       (string-count medium-string char-alphabetic?)
 265       (string-count long-string char-alphabetic?))
 266
 267     (benchmark "contains contains-ci" 34000
 268       (string-contains short-string short-string)
 269       (string-contains medium-string (substring medium-string 10 15))
 270       (string-contains long-string (substring long-string 100 130))
 271       (string-contains-ci short-string short-string)
 272       (string-contains-ci medium-string (substring medium-string 10 15))
 273       (string-contains-ci long-string (substring long-string 100 130)))
 274
 275     (set! str1 (string-copy short-string))
 276     (set! str2 (string-copy medium-string))
 277     (set! str3 (string-copy long-string))
 278
 279     (benchmark "upcase downcase upcase! downcase!" 600
 280       (string-upcase short-string)
 281       (string-upcase medium-string)
 282       (string-upcase long-string)
 283       (string-downcase short-string)
 284       (string-downcase medium-string)
 285       (string-downcase long-string)
 286       (string-upcase! str1 0 1)
 287       (string-upcase! str2 10 20)
 288       (string-upcase! str3 100 130)
 289       (string-downcase! str1 0 1)
 290       (string-downcase! str2 10 20)
 291       (string-downcase! str3 100 130)))
 292
 293   (with-benchmark-prefix "readers"
 294
 295     (benchmark "read token, method 1" 1200
 296       (let ((buf (make-string 512)))
 297         (let loop ((i 0))
 298           (if (< i 512)
 299               (begin
 300                 (string-set! buf i #\x)
 301                 (loop (+ i 1)))
 302               buf))))
 303
 304     (benchmark "read token, method 2" 1200
 305       (let ((lst '()))
 306         (let loop ((i 0))
 307           (set! lst (append! lst (list #\x)))
 308           (if (< i 512)
 309               (loop (+ i 1))
 310               (list->string lst)))))))