| 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) |