Changed the typed benchmarks and the benchmark harness to use wrapper
modules to turn typed Scheme's optimization on and off.
This commit is contained in:
Vincent St-Amour
parent
20cd21440f
commit
1ac3f6905f
|
|
@ -401,10 +401,22 @@ exec racket -qu "$0" ${1+"$@"}
|
|||
void
|
||||
mk-racket
|
||||
(lambda (bm)
|
||||
(system (format "racket -u ~a-typed.rkt" bm)))
|
||||
(system (format "racket -u ~a-typed-non-optimizing.rkt" bm)))
|
||||
extract-racket-times
|
||||
clean-up-zo
|
||||
mutable-pair-progs)
|
||||
(append mutable-pair-progs
|
||||
'(dynamic2 earley maze2 nboyer nucleic2 sboyer
|
||||
scheme2)))
|
||||
(make-impl 'typed-scheme-optimizing
|
||||
void
|
||||
mk-racket
|
||||
(lambda (bm)
|
||||
(system (format "racket -u ~a-typed-optimizing.rkt" bm)))
|
||||
extract-racket-times
|
||||
clean-up-zo
|
||||
(append mutable-pair-progs
|
||||
'(dynamic2 earley maze2 nboyer nucleic2 sboyer
|
||||
scheme2)))
|
||||
(make-impl 'chicken
|
||||
void
|
||||
(run-mk "mk-chicken.rktl")
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module cpstack-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module cpstack-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -11,8 +11,6 @@
|
|||
;;; CPSTAK -- A continuation-passing version of the TAK benchmark.
|
||||
;;; A good test of first class procedures and tail recursion.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: cpstak (Integer Integer Integer -> Integer))
|
||||
(define (cpstak x y z)
|
||||
(: tak (Integer Integer Integer (Integer -> Integer) -> Integer))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module ctak-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module ctak-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -21,8 +21,6 @@
|
|||
|
||||
;;; CTAK -- A version of the TAK function that uses the CATCH/THROW facility.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: ctak (Integer Integer Integer -> Integer))
|
||||
(define (ctak x y z)
|
||||
((inst call-with-current-continuation Integer Integer)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module dderiv-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module dderiv-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -35,8 +35,6 @@
|
|||
; Returns the wrong answer for quotients.
|
||||
; Fortunately these aren't used in the benchmark.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(define-type Plist (Listof (Pair Symbol ((Listof Deriv) -> Deriv))))
|
||||
|
||||
(: pg-alist Plist)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module deriv-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module deriv-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -18,8 +18,6 @@
|
|||
; Returns the wrong answer for quotients.
|
||||
; Fortunately these aren't used in the benchmark.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(define-type Deriv (Rec Deriv (U Number
|
||||
Symbol
|
||||
(Pair (U '+ '- '* '/)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module div-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module div-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -13,8 +13,6 @@
|
|||
;;; DIV2 -- Benchmark which divides by 2 using lists of n ()'s.
|
||||
;;; This file contains a recursive as well as an iterative test.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: create-n (Integer -> (Listof Any)))
|
||||
(define (create-n n)
|
||||
(do ((n n (- n 1))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module fft-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module fft-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -10,8 +10,6 @@
|
|||
; Status: Public Domain
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: pi Complex)
|
||||
(define pi (atan 0 -1))
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module graphs-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module graphs-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -12,8 +12,6 @@
|
|||
|
||||
; End of new code.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
;;; ==== std.ss ====
|
||||
|
||||
; (define-syntax assert
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module lattice2-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module lattice2-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -3,8 +3,6 @@
|
|||
|
||||
;;; LATTICE -- Obtained from Andrew Wright.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(define-type Verdict (U 'less 'more 'equal 'uncomparable))
|
||||
|
||||
;; Given a comparison routine that returns one of
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module mazefun-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module mazefun-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -1,8 +1,6 @@
|
|||
;;; MAZEFUN -- Constructs a maze in a purely functional way,
|
||||
;;; written by Marc Feeley.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: iota (Integer -> (Listof Integer)))
|
||||
(define iota
|
||||
(lambda (n)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module nestedloop-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module nestedloop-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -1,5 +1,3 @@
|
|||
#lang typed/scheme/base
|
||||
|
||||
;; Imperative body:
|
||||
(: loops (Integer -> Integer))
|
||||
(define (loops n)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module nfa-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module nfa-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -3,8 +3,6 @@
|
|||
;; Changed by Matthew 2006/08/21 to move string->list out of the loop
|
||||
;; Changed by Vincent 2010/04/05 to convert to typed Scheme
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(define-type Result (U 'state2 'state4 #f))
|
||||
|
||||
(: recursive-nfa ((Listof Char) -> (U 'state2 'state4 'fail)))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module nothing-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module nothing-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -1,3 +1 @@
|
|||
#lang typed/scheme/base
|
||||
|
||||
(time 1)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module nqueens-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module nqueens-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -3,7 +3,6 @@
|
|||
;; 2010/04 -- got rid of the one-armed id (stamourv)
|
||||
;; 2010/05 -- ported to typed Scheme (stamourv)
|
||||
|
||||
#lang typed/scheme/base
|
||||
(define trace? #f)
|
||||
|
||||
(: nqueens (Integer -> Integer))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module paraffins-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module paraffins-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -1,7 +1,5 @@
|
|||
;;; PARAFFINS -- Compute how many paraffins exist with N carbon atoms.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(require/typed scheme/base (collect-garbage ( -> Void)))
|
||||
|
||||
(define-type Radical (Rec Radical (U 'C 'H 'BCP 'CCP (Vectorof Radical))))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module puzzle-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module puzzle-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -10,8 +10,6 @@
|
|||
; Status: Public Domain
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: iota (Integer -> (Listof Integer)))
|
||||
(define (iota n)
|
||||
(do: : (Listof Integer)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module tak-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module tak-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -12,8 +12,6 @@
|
|||
|
||||
;;; TAK -- A vanilla version of the TAKeuchi function
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: tak (Integer Integer Integer -> Integer))
|
||||
(define (tak x y z)
|
||||
(if (not (< y x))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module takl-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module takl-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -12,8 +12,6 @@
|
|||
|
||||
;;; TAKL -- The TAKeuchi function using lists as counters.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: listn (Integer -> (Listof Integer)))
|
||||
(define (listn n)
|
||||
(if (not (= 0 n))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module takr-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module takr-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -14,8 +14,6 @@
|
|||
;;; memory effects. Results should be the same as for TAK on stack machines.
|
||||
;;; Distribution of calls is not completely flat.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: tak0 (Integer Integer Integer -> Integer))
|
||||
(define (tak0 x y z)
|
||||
(cond ((not (< y x)) z)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module takr2-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module takr2-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -14,8 +14,6 @@
|
|||
;;; memory effects. Results should be the same as for TAK on stack machines.
|
||||
;;; Distribution of calls is not completely flat.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: tak (Integer Integer Integer -> Integer))
|
||||
(define (tak x y z)
|
||||
(: tak0 (Integer Integer Integer -> Integer))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module triangle-typed-non-optimizing "wrap-typed-non-optimizing.ss")
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(module triangle-typed-optimizing "wrap-typed-optimizing.ss")
|
||||
|
|
@ -13,8 +13,6 @@
|
|||
|
||||
;;; TRIANG -- Board game benchmark.
|
||||
|
||||
#lang typed/scheme/base
|
||||
|
||||
(: *board* (Vectorof Integer))
|
||||
(define *board* (make-vector 16 1))
|
||||
(: *sequence* (Vectorof Integer))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,15 @@
|
|||
|
||||
(module wrap-typed-non-optimizing racket
|
||||
(provide (rename-out (module-begin #%module-begin)))
|
||||
(require (lib "include.ss"))
|
||||
(require (prefix-in ts: typed/scheme/base))
|
||||
(require typed/scheme/base)
|
||||
(define-syntax (module-begin stx)
|
||||
(let ([name (symbol->string (syntax-property stx 'enclosing-module-name))])
|
||||
#`(ts:#%module-begin
|
||||
(include #,(format "~a.rkt"
|
||||
(substring name
|
||||
0
|
||||
(caar (regexp-match-positions
|
||||
#rx"-non-optimizing"
|
||||
name)))))))))
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
|
||||
(module wrap-typed-optimizing racket
|
||||
(provide (rename-out (module-begin #%module-begin)))
|
||||
(require (lib "include.ss"))
|
||||
(require (prefix-in ts: typed/scheme/base))
|
||||
(require typed/scheme/base)
|
||||
(define-syntax (module-begin stx)
|
||||
(let ([name (symbol->string (syntax-property stx 'enclosing-module-name))])
|
||||
#`(ts:#%module-begin #:optimize
|
||||
(include #,(format "~a.rkt"
|
||||
(substring name
|
||||
0
|
||||
(caar (regexp-match-positions
|
||||
#rx"-optimizing"
|
||||
name)))))))))
|
||||
Loading…
Reference in New Issue
Block a user