Commit | Line | Data |
---|---|---|
2d80426a LC |
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) | |
d0927dde | 12 | :use-module (system vm vm) |
2d80426a LC |
13 | :use-module (system base compile) |
14 | :use-module (system base language)) | |
15 | ||
f41cb00c | 16 | |
2d80426a LC |
17 | (define (time-for-eval sexp eval) |
18 | (let ((before (tms:utime (times)))) | |
f41cb00c | 19 | (eval sexp) |
2d80426a LC |
20 | (let ((elapsed (- (tms:utime (times)) before))) |
21 | (format #t "elapsed time: ~a~%" elapsed) | |
22 | elapsed))) | |
23 | ||
24 | (define *scheme* (lookup-language 'scheme)) | |
25 | ||
f41cb00c | 26 | \f |
2d80426a LC |
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)))) | |
f41cb00c LC |
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~%"))) | |
616167fc | 46 | (the-program (compile proc-source)) |
f41cb00c | 47 | |
f41cb00c LC |
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))) | |
2d80426a LC |
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) |