Browse files

Testing and benchmarking macros

  • Loading branch information...
pavpanchekha committed Nov 20, 2013
1 parent 016e026 commit 27e1731633f2ef6a23a861e9ed4ee05d2d8dea2f
Showing with 60 additions and 0 deletions.
  1. +60 −0 casio/test.rkt
@@ -0,0 +1,60 @@
#lang racket
(require casio/main)
(require rackunit)
(define (unfold-let expr)
(match expr
[`(let ,vars ,body)
(let loop ([vars vars] [body body])
(if (null? vars)
(let ([var (caar vars)] [val (cadar vars)])
(loop (map (replace-var var val) (cdr vars))
((replace-var var val) body)))))]
[`(,head ,args ...)
(cons head (map unfold-let args))]
(define ((replace-var var val) expr)
[(eq? expr var) val]
[(list? expr)
(cons (car expr) (map (replace-var var val) (cdr expr)))]
(define (bench-results name inerr outerr)
(printf "~a orders: ~s\n"
(/ (round (* (- (/ (log (/ outerr (max inerr 1e-16)))
(log 10))) 10)) 10)
(define-binary-check (check-member (lambda (x y) (member y x)) elt lst))
(define-syntax (casio-test stx)
(syntax-case stx ()
[(_ vars name input output)
#`(let* ([prog '(lambda vars input)]
[alts (map alternative-program
(heuristic-execute prog 5))])
(with-check-info (['start 'input] ['goal 'output])
(check-member alts 'output name)))]))
(define-syntax (casio-bench stx)
(syntax-case stx ()
[(_ vars name input)
#`(let* ([pts (make-points)]
[prog '(lambda vars input)]
[exacts (make-exacts prog pts)]
[output (alternative-program
(car (sort (heuristic-execute prog 5)
#:key alternative-score list<)))])
(let-values ([(prog-score prog-specials)
(max-error prog pts exacts)]
[(goal-score goal-specials)
(max-error output pts exacts)])
(bench-results name prog-score goal-score)))]))
(provide casio-test casio-bench)

0 comments on commit 27e1731

Please sign in to comment.