suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

redex: fix some more benchmark paths

Browse Source
This commit is contained in:
Burke Fetscher 2014-02-17 16:30:06 -06:00
parent 2d3c25bc16
commit 3d282eba29
3 changed files with 50 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/make-mutants.rkt
View File

@ -4,21 +4,24 @@
racket/runtime-path)
(provide directories
get-directories
get-directory
get-base-stem)
(define-runtime-path stlc "stlc")
(define-runtime-path stlc-sub "stlc-sub")
(define-runtime-path poly-stlc "poly-stlc")
(define-runtime-path rbtrees "rbtrees")
(define-runtime-path delim-cont "delim-cont")
(define-runtime-path list-machine "list-machine")
(define directories (list "stlc"
"stlc-sub"
"poly-stlc"
"rbtrees"
"delim-cont"
"list-machine"))
(define-runtime-path here ".")
(define directories (list stlc
stlc-sub
poly-stlc
rbtrees
delim-cont
list-machine))
(define (get-directory name)
(build-path here name))
(define (get-directories names)
(map get-directory names))
(define (make-mutants directory)
(cond
@ -35,7 +38,7 @@
(copy-file base name #t)
(system* (find-executable-path "patch") name (path->string f)))]
[else
(map make-mutants directories)]))
(map make-mutants (get-directories directories))]))
(define (get-base-stem files)
(car (filter-map (λ (f) (regexp-match #rx"^(.*)-base\\.rkt$" (path->string f))) files)))

25
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/run-muts.rkt
View File

@ -6,6 +6,7 @@
racket/place
racket/match
racket/system
racket/runtime-path
"make-mutants.rkt")
(define names '())
@ -35,17 +36,18 @@
[("-t" "--type") t "Generation type to run, one of: search, grammar, search-gen, search-gen-ref, search-gen-enum, search-gen-enum-ref"
(set! gen-types (cons (string->symbol t) gen-types))])
(define-runtime-path here ".")
(when (empty? files)
(set! files
(flatten
(for/list ([name (in-list names)])
(define path (build-path (current-directory) name))
(filter
(curry regexp-match #px"^.*([\\d]+|base)\\.rkt$")
(map
(λ (fp)
(string-append name "/" (path->string fp)))
(directory-list path)))))))
(for/list ([dir (in-list names)])
(map
(λ (fn)
(string-append dir "/" (path->string fn)))
(filter
(curry regexp-match #px"^.*([\\d]+|base)\\.rkt$")
(directory-list (get-directory dir))))))))
(define worklist files)
@ -58,10 +60,9 @@
(semaphore-post work-sem)
(void)]
[else
(define fname (car worklist))
(define path (simplify-path (build-path here (car worklist))))
(set! worklist (cdr worklist))
(semaphore-post work-sem)
(define fullpath (build-path (current-directory) fname))
(define args (apply string-append
(add-between (list* (if verbose? "-v" "")
(string-append "-m " (number->string minutes))
@ -70,8 +71,8 @@
(symbol->string t)))
gen-types))
" ")))
(system (let ([ans (apply string-append (add-between (list "racket" "test-file.rkt" args (path->string fullpath)) " "))])
(system (let ([ans (apply string-append (add-between (list "racket" (path->string (build-path here "test-file.rkt"))
args (path->string path)) " "))])
(printf "~s\n" ans)
ans))
(do-next)]))

37
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt
View File

@ -5,6 +5,7 @@
racket/list
racket/set
racket/match
racket/path
math/statistics)
(define minutes 1)
@ -102,16 +103,20 @@
((/ dev avg) . > . 0.1)))
(define (test-file fname verbose? no-errs? gen-type seconds)
(define tc (dynamic-require fname 'type-check))
(define check (dynamic-require fname 'check))
(define gen-term (dynamic-require fname 'generate-M-term))
(define gen-typed-term (dynamic-require fname 'generate-typed-term))
(define typed-generator (dynamic-require fname 'typed-generator))
(define gen-enum (dynamic-require fname 'generate-enum-term))
(define err (dynamic-require fname 'the-error))
(define maybe-fpath (string->path fname))
(define fpath (if (relative-path? maybe-fpath)
maybe-fpath
(find-relative-path (current-directory) maybe-fpath)))
(define tc (dynamic-require fpath 'type-check))
(define check (dynamic-require fpath 'check))
(define gen-term (dynamic-require fpath 'generate-M-term))
(define gen-typed-term (dynamic-require fpath 'generate-typed-term))
(define typed-generator (dynamic-require fpath 'typed-generator))
(define gen-enum (dynamic-require fpath 'generate-enum-term))
(define err (dynamic-require fpath 'the-error))
(printf "\n-------------------------------------------------------------------\n")
(printf "~a has the error: ~a\n\n" fname err)
(printf "Running ~a....\n" fname)
(printf "~a has the error: ~a\n\n" fpath err)
(printf "Running ~a....\n" fpath)
(printf "Using generator: ~s\n" gen-type)
(define (gen-and-type gen)
(λ ()
@ -121,16 +126,16 @@
t))))
(cond
[(equal? gen-type 'grammar)
(run-generations fname verbose? no-errs? (gen-and-type gen-term)
(run-generations fpath verbose? no-errs? (gen-and-type gen-term)
check seconds gen-type)]
[(equal? gen-type 'enum)
(run-generations fname verbose? no-errs? (gen-and-type gen-enum)
(run-generations fpath verbose? no-errs? (gen-and-type gen-enum)
check seconds gen-type)]
[(equal? gen-type 'search)
(run-generations fname verbose? no-errs? (λ () gen-typed-term)
(run-generations fpath verbose? no-errs? (λ () gen-typed-term)
check seconds gen-type)]
[(equal? gen-type 'search-gen)
(run-generations fname verbose? no-errs? typed-generator
(run-generations fpath verbose? no-errs? typed-generator
check seconds gen-type)]
[(equal? gen-type 'search-gen-ref)
(define t (current-process-milliseconds))
@ -140,11 +145,11 @@
(set! t (current-process-milliseconds))
(set! g (typed-generator)))
(g))
(run-generations fname verbose? no-errs? (λ () gen)
(run-generations fpath verbose? no-errs? (λ () gen)
check seconds gen-type)]
[(equal? gen-type 'search-gen-enum)
(parameterize ([gen-state (set-remove (gen-state) 'shuffle-clauses)])
(run-generations fname verbose? no-errs? typed-generator
(run-generations fpath verbose? no-errs? typed-generator
check seconds gen-type))]
[(equal? gen-type 'search-gen-enum-ref)
(parameterize ([gen-state (set-remove (gen-state) 'shuffle-clauses)])
@ -155,7 +160,7 @@
(set! t (current-process-milliseconds))
(set! g (typed-generator)))
(g))
(run-generations fname verbose? no-errs? (λ () gen)
(run-generations fpath verbose? no-errs? (λ () gen)
check seconds gen-type))]))
(for ([gen-type (in-list types)])