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) racket/runtime-path)
(provide directories (provide directories
get-directories
get-directory
get-base-stem) get-base-stem)
(define-runtime-path stlc "stlc") (define directories (list "stlc"
(define-runtime-path stlc-sub "stlc-sub") "stlc-sub"
(define-runtime-path poly-stlc "poly-stlc") "poly-stlc"
(define-runtime-path rbtrees "rbtrees") "rbtrees"
(define-runtime-path delim-cont "delim-cont") "delim-cont"
(define-runtime-path list-machine "list-machine") "list-machine"))
(define-runtime-path here ".")
(define directories (list stlc (define (get-directory name)
stlc-sub (build-path here name))
poly-stlc
rbtrees (define (get-directories names)
delim-cont (map get-directory names))
list-machine))
(define (make-mutants directory) (define (make-mutants directory)
(cond (cond
@ -35,7 +38,7 @@
(copy-file base name #t) (copy-file base name #t)
(system* (find-executable-path "patch") name (path->string f)))] (system* (find-executable-path "patch") name (path->string f)))]
[else [else
(map make-mutants directories)])) (map make-mutants (get-directories directories))]))
(define (get-base-stem files) (define (get-base-stem files)
(car (filter-map (λ (f) (regexp-match #rx"^(.*)-base\\.rkt$" (path->string f))) 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/place
racket/match racket/match
racket/system racket/system
racket/runtime-path
"make-mutants.rkt") "make-mutants.rkt")
(define names '()) (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" [("-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))]) (set! gen-types (cons (string->symbol t) gen-types))])
(define-runtime-path here ".")
(when (empty? files) (when (empty? files)
(set! files (set! files
(flatten (flatten
(for/list ([name (in-list names)]) (for/list ([dir (in-list names)])
(define path (build-path (current-directory) name)) (map
(filter (λ (fn)
(curry regexp-match #px"^.*([\\d]+|base)\\.rkt$") (string-append dir "/" (path->string fn)))
(map (filter
(λ (fp) (curry regexp-match #px"^.*([\\d]+|base)\\.rkt$")
(string-append name "/" (path->string fp))) (directory-list (get-directory dir))))))))
(directory-list path)))))))
(define worklist files) (define worklist files)
@ -58,10 +60,9 @@
(semaphore-post work-sem) (semaphore-post work-sem)
(void)] (void)]
[else [else
(define fname (car worklist)) (define path (simplify-path (build-path here (car worklist))))
(set! worklist (cdr worklist)) (set! worklist (cdr worklist))
(semaphore-post work-sem) (semaphore-post work-sem)
(define fullpath (build-path (current-directory) fname))
(define args (apply string-append (define args (apply string-append
(add-between (list* (if verbose? "-v" "") (add-between (list* (if verbose? "-v" "")
(string-append "-m " (number->string minutes)) (string-append "-m " (number->string minutes))
@ -70,8 +71,8 @@
(symbol->string t))) (symbol->string t)))
gen-types)) gen-types))
" "))) " ")))
(system (let ([ans (apply string-append (add-between (list "racket" (path->string (build-path here "test-file.rkt"))
(system (let ([ans (apply string-append (add-between (list "racket" "test-file.rkt" args (path->string fullpath)) " "))]) args (path->string path)) " "))])
(printf "~s\n" ans) (printf "~s\n" ans)
ans)) ans))
(do-next)])) (do-next)]))

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

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