benchmark/measure.scm

   1 #!/bin/sh
   2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
   3 main='(module-ref (resolve-module '\''(measure)) '\'main')'
   4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
   5 !#
   6
   7 ;; A simple interpreter vs. VM performance comparison tool
   8 ;;
   9
  10 (define-module (measure)
  11   :export (measure)
  12   :use-module (system vm vm)
  13   :use-module (system base compile)
  14   :use-module (system base language))
  15
  16
  17 (define (time-for-eval sexp eval)
  18   (let ((before (tms:utime (times))))
  19     (eval sexp)
  20     (let ((elapsed (- (tms:utime (times)) before)))
  21       (format #t "elapsed time: ~a~%" elapsed)
  22       elapsed)))
  23
  24 (define *scheme* (lookup-language 'scheme))
  25
  26 \f
  27 (define (measure . args)
  28   (if (< (length args) 2)
  29       (begin
  30         (format #t "Usage: measure SEXP FILE-TO-LOAD...~%")
  31         (format #t "~%")
  32         (format #t "Example: measure '(loop 23424)' lib.scm~%~%")
  33         (exit 1)))
  34   (for-each load (cdr args))
  35   (let* ((sexp (with-input-from-string (car args)
  36                  (lambda ()
  37                    (read))))
  38          (eval-here (lambda (sexp) (eval sexp (current-module))))
  39          (proc-name (car sexp))
  40          (proc-source (procedure-source (eval proc-name (current-module))))
  41          (% (format #t "proc: ~a~%source: ~a~%" proc-name proc-source))
  42          (time-interpreted (time-for-eval sexp eval-here))
  43          (& (if (defined? proc-name)
  44                 (eval `(set! ,proc-name #f) (current-module))
  45                 (format #t "unbound~%")))
  46          (the-program (compile proc-source))
  47
  48          (time-compiled (time-for-eval `(,proc-name ,@(cdr sexp))
  49                                        (lambda (sexp)
  50                                          (eval `(begin
  51                                                   (define ,proc-name
  52                                                     ,the-program)
  53                                                   ,sexp)
  54                                                (current-module))))))
  55
  56     (format #t "proc:        ~a => ~a~%"
  57             proc-name (eval proc-name (current-module)))
  58     (format #t "interpreted: ~a~%" time-interpreted)
  59     (format #t "compiled:    ~a~%" time-compiled)
  60     (format #t "speedup:     ~a~%"
  61             (exact->inexact (/ time-interpreted time-compiled)))
  62     0))
  63
  64 (define main measure)