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

add enum generation to stlc

Browse Source
This commit is contained in:
Burke Fetscher 2014-02-17 14:57:27 -06:00
parent 10de717cb4
commit 0010a8ebae
12 changed files with 74 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,7 +8,6 @@
(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")

6
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-10.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/match
racket/contract
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -245,6 +246,9 @@
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

6
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-2.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/contract
racket/match
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -245,6 +246,9 @@
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

6
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-3.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/match
racket/contract
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -246,6 +247,9 @@
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

6
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-4.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/match
racket/contract
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -246,6 +247,9 @@
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

6
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-5.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/match
racket/contract
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -245,6 +246,9 @@
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

6
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-6.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/match
racket/contract
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -245,6 +246,9 @@
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

6
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-7.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/match
racket/contract
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -244,6 +245,9 @@
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

6
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-8.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/match
racket/contract
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -245,6 +246,9 @@
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

6
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-9.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/match
racket/contract
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -245,6 +246,9 @@
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

8
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-base.rkt
View File

@ -6,6 +6,7 @@
racket/list
racket/contract
racket/match
math/base
"tut-subst.rkt")
(provide (all-defined-out))
@ -245,7 +246,10 @@
(let ([red-res (apply-reduction-relation red term)]
[t-type (type-check term)])
(and
(= (length red-res) 1)
(or
(= (length red-res) 1)
(or
(equal? (car red-res) "error")
(equal? t-type (type-check (car red-res))))))))
(define (generate-enum-term)
(generate-term stlc M #:i-th (random-natural #e10e200)))

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

@ -11,7 +11,9 @@
(define verbose #f)
(define output-file #f)
(define all-types '(search grammar search-gen search-gen-ref search-gen-enum search-gen-enum-ref))
(define all-types '(search grammar search-gen search-gen-ref
search-gen-enum search-gen-enum-ref
enum))
(define types '())
(define filename
@ -24,7 +26,7 @@
[("-o" "--output") out-file "Output file name"
(set! output-file out-file)]
#:multi
[("-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, enum"
(set! types (cons (string->symbol t) types))]
#:args filenames
(match filenames
@ -100,24 +102,29 @@
((/ dev avg) . > . 0.1)))
(define (test-file fname verbose? no-errs? gen-type seconds)
(define fpath (string->path fname))
(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 err (dynamic-require fpath 'the-error))
(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))
(printf "\n-------------------------------------------------------------------\n")
(printf "~s has the error: ~a\n\n" fname err)
(printf "Running ~s....\n" fname)
(printf "~a has the error: ~a\n\n" fname err)
(printf "Running ~a....\n" fname)
(printf "Using generator: ~s\n" gen-type)
(define (gen-and-type gen)
(λ ()
(λ ()
(define t (gen))
(and (tc t)
t))))
(cond
[(equal? gen-type 'grammar)
(define (gen-and-type)
(define t (gen-term))
(and (tc t)
t))
(run-generations fname verbose? no-errs? (λ () gen-and-type)
(run-generations fname 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)
check seconds gen-type)]
[(equal? gen-type 'search)
(run-generations fname verbose? no-errs? (λ () gen-typed-term)