#lang scheme/base ;;; @Package shootout ;;; @Subtitle Expression Performance Comparison for Racket ;;; @HomePage http://www.neilvandyke.org/racket-shootout/ ;;; @Author Neil Van Dyke ;;; @Version 0.1 ;;; @Date 2010-12-21 ;;; @PLaneT neil/shootout:1:0 ;; $Id: shootout.ss,v 1.16 2010/12/21 19:20:04 neilpair Exp $ ;;; @legal ;;; Copyright @copyright{} 2010 Neil Van Dyke. This program is 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 of the License (LGPL 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 ;;; @indicateurl{http://www.gnu.org/licenses/} for details. For other licenses ;;; and consulting, please contact the author. ;;; @end legal (require (for-syntax scheme/base)) ;;; @section Introduction ;;; This package provides the @code{shootout} syntax, which is a convenient ;;; tool to help compare the performance of multiple Racket expressions. This ;;; can be useful when hand-optimizing performance-sensitive Racket code. ;;; ;;; For example, the program: ;;; ;;; @lisp ;;; (define (va x (y "bbb") (z "ccc")) ;;; (expt 42 42) ;;; (string-append x y z)) ;;; ;;; (define (fa x y z) ;;; (expt 42 42) ;;; (string-append x y z)) ;;; ;;; (shootout (va "aaa") ;;; (fa "aaa" "bbb" "ccc") ;;; #:repeat 1000000) ;;; @end lisp ;;; ;;; might produce a log similar to: ;;; ;;; @example ;;; SHOOTOUT-SAMPLING-GC-BASE ;;; ;;; SHOOTOUT-BEGIN (REPEAT 1000000, GC-BASE-MS 2498, GC-BASE-GCMS 2496) ;;; ;;; SHOOTOUT-EXPRESSION 1: ;;; (va "aaa") ;;; SHOOTOUT-TIMING (RUN 275, RUN-GCMS 12, COST 274, COST-GCMS 12, CLEANUP-DIFF -2.0) ;;; ;;; SHOOTOUT-EXPRESSION 2: ;;; (fa "aaa" "bbb" "ccc") ;;; SHOOTOUT-TIMING (RUN 255, RUN-GCMS 12, COST 254, COST-GCMS 13, CLEANUP-DIFF -1.0) ;;; ;;; SHOOTOUT-END ;;; @end example ;;; ;;; The most meaningful numbers in this version of @code{shootout} are ``RUN'' ;;; and ``RUN-GCMS''. RUN is the real time in milliseconds during which the ;;; expression ran for the specificed number of iteractions (the ``REPEAT'' ;;; number). ``RUN-GMCS'' is the number of milliseconds of garbage collection ;;; (GC) time that occurred during the run. Neither of these numbers includes ;;; the GC ``cleanup'' time that @code{shootout} performs in an attempt to ;;; gauge any lingering GC cost of the expression. ;;; ;;; Note that multiple runs of @code{shootout} may give substantially different ;;; results. So, you may wish to run multiple times and take the variation ;;; into consideration before drawing any conclusions. ;;; ;;; Note that @code{shootout} is only an aid for performance-comparison, and ;;; does not control for all variables, nor are its measurements necessarily ;;; accurate. ;; TODO: !!! Improve documentation, once this has stabilized. ;;; @section Interface ;;; @defsyntax shootout expr ... [ #:repeat repeat ] ;;; ;;; Performs @var{repeat} iterations of each @var{expr} and reports performance ;;; information in a log. ;;; ;;; Note that the format of this log and the information is reports is likely ;;; to change in future versions of this package. (define-syntax shootout (syntax-rules () ((_ ARGn ...) (%shootout:1 (ARGn ...) () #f #f 1000)))) (define-syntax %shootout:1 ;; (_ ARGs EXPRs GC-BASE-MS GC-BASE-GCMS REPEAT) (syntax-rules () ;; Arg is "#:gc-base-ms": ((_ (#:gc-base-ms X ARGn ...) EXPRs GC-BASE-MS GC-BASE-GCMS REPEAT) (%shootout:1 (ARGn ...) EXPRs X GC-BASE-GCMS REPEAT)) ;; Arg is "#:gc-base-gcms": ((_ (#:gc-base-gcms X ARGn ...) EXPRs GC-BASE-MS GC-BASE-GCMS REPEAT) (%shootout:1 (ARGn ...) EXPRs GC-BASE-MS X REPEAT)) ;; Arg is "#:repeat": ((_ (#:repeat X ARGn ...) EXPRs GC-BASE-MS GC-BASE-GCMS REPEAT) (%shootout:1 (ARGn ...) EXPRs GC-BASE-MS GC-BASE-GCMS X)) ;; Arg is expression: ((_ (ARG0 ARGn ...) (EXPRn ... ) GC-BASE-MS GC-BASE-GCMS REPEAT) (%shootout:1 (ARGn ...) (EXPRn ... ARG0) GC-BASE-MS GC-BASE-GCMS REPEAT)) ;; No more args: ((_ () EXPRs GC-BASE-MS GC-BASE-GCMS REPEAT) (let ((gc-base-ms GC-BASE-MS) (gc-base-gcms GC-BASE-GCMS) (repeat REPEAT) (log (current-output-port))) (%shootout:2 EXPRs gc-base-ms gc-base-gcms repeat log (+ 1) ()))))) (define-syntax %shootout:2 ;; (_ EXPRs GC-BASE-MS GC-BASE-GCMS REPEAT LOG PLUS OUT) (syntax-rules () ((_ () GC-BASE-MS GC-BASE-GCMS REPEAT LOG PLUS (OUTn ...)) (begin (or (and GC-BASE-MS GC-BASE-GCMS) (begin ;; TODO: Give warning if one is specified but not the other. (display "\nSHOOTOUT-SAMPLING-GC-BASE\n") (flush-output) (collect-garbage) (collect-garbage) (collect-garbage) (let ((start-ms (current-inexact-milliseconds)) (start-gcms (current-gc-milliseconds))) (collect-garbage) (collect-garbage) (collect-garbage) (let ((end-ms (current-inexact-milliseconds)) (end-gcms (current-gc-milliseconds))) (set! GC-BASE-MS (- end-ms start-ms)) (set! GC-BASE-GCMS (- end-gcms start-gcms)))))) (display "\nSHOOTOUT-BEGIN (REPEAT " LOG) (display REPEAT LOG) (display ", GC-BASE-MS " LOG) (display (inexact->exact (round GC-BASE-MS)) LOG) (display ", GC-BASE-GCMS " LOG) (display (inexact->exact (round GC-BASE-GCMS)) LOG) (display ")\n" LOG) OUTn ... (display "\nSHOOTOUT-END\n" LOG))) ((_ (EXPR0 EXPRn ...) GC-BASE-MS GC-BASE-GCMS REPEAT LOG (PLUSn ...) (OUTn ...)) (%shootout:2 (EXPRn ...) GC-BASE-MS GC-BASE-GCMS REPEAT LOG (PLUSn ... 1) (OUTn ... (display "\nSHOOTOUT-EXPRESSION " LOG) (display (PLUSn ...) LOG) (display ":\n" LOG) (write (quote EXPR0) LOG) (write-char #\newline LOG) (flush-output LOG) (collect-garbage) (collect-garbage) (collect-garbage) (let* ((start-mstp (current-inexact-milliseconds)) (start-gcmstp (current-gc-milliseconds))) (let loop ((times REPEAT)) (or (<= times 0) (begin EXPR0 (loop (- times 1))))) ;; Note: We can't inhibit the GC, so little point in getting the ;; cleanup cost here. (let ((ran-mstp (current-inexact-milliseconds)) (ran-gcmstp (current-gc-milliseconds))) (collect-garbage) (collect-garbage) (collect-garbage) (let* ((end-mstp (current-inexact-milliseconds)) (end-gcmstp (current-gc-milliseconds)) (run-ms (- ran-mstp start-mstp)) (cleanup-ms (- end-mstp ran-mstp)) (cleanup-cost-ms (- cleanup-ms GC-BASE-MS)) (total-ms (- end-mstp start-mstp)) (cost-ms (- total-ms GC-BASE-MS)) (run-gcms (- ran-gcmstp start-gcmstp)) (total-gcms (- end-gcmstp start-gcmstp)) (cost-gcms (- total-gcms GC-BASE-GCMS))) ;; (printf "*DEBUG* ~S\n" ;; `((cleanup-ms ,cleanup-ms) ;; (cleanup-cost-ms ,cleanup-cost-ms))) (display "SHOOTOUT-TIMING (RUN " LOG) (display (inexact->exact (round run-ms)) LOG) (display ", RUN-GCMS " LOG) (display (inexact->exact (round run-gcms)) LOG) (display ", COST " LOG) (display (inexact->exact (round cost-ms)) LOG) (display ", COST-GCMS " LOG) (display (inexact->exact (round cost-gcms)) LOG) (display ", CLEANUP-DIFF " LOG) (display (round cleanup-cost-ms) LOG) (display ")\n" LOG))))))))) ;;; @unnumberedsec History ;;; @table @asis ;;; ;;; @item Version 0.1 --- 2010-12-21 -- PLaneT @code{(1 0)} ;;; Initial release. ;;; ;;; @end table (provide shootout)