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

trying to get the conform benchmark running

Browse Source
This commit is contained in:
Danny Yoo 2011-03-14 16:05:59 -04:00
parent b5f7845a0e
commit cc61b1daf1
4 changed files with 170 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
runtime.js
View File

@ -150,8 +150,36 @@ var Primitives = (function() {
'sub1': function(arity, returnLabel) { 'sub1': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1]; var firstArg = MACHINE.env[MACHINE.env.length-1];
return firstArg - 1; return firstArg - 1;
},
'vector': function(arity, returnLabel) {
var i;
var result = [];
for (i = 0; i < arity; i++) {
result.push(MACHINE.env[MACHINE.env.length-1-i]);
} }
, return result;
},
'vector-ref': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
return firstArg[secondArg];
},
'vector-set!': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
var thirdArg = MACHINE.env[MACHINE.env.length-3];
firstArg[secondArg] = thirdArg;
return null;
},
'symbol?': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
return typeof(firstArg) === 'string';
},
'call/cc': new Closure(callCCEntry, 'call/cc': new Closure(callCCEntry,
1, 1,
[], [],

5
test-browser-evaluate.rkt
View File

@ -141,3 +141,8 @@
(tak (- z 1) x y))))]) (tak (- z 1) x y))))])
(displayln (tak 18 12 6))) (displayln (tak 18 12 6)))
"7\n") "7\n")
(test (read (open-input-file "tests/conform/program0.sch"))
(port->string (open-input-file "tests/conform/expected0.txt")))

137
test-compiler.rkt
View File

@ -17,9 +17,9 @@
(with-syntax ([stx stx]) (with-syntax ([stx stx])
(syntax/loc #'stx (syntax/loc #'stx
(begin (begin
(printf "Running ~s ...\n" 'code) (printf "Running ~s ...\n" code)
(let*-values([(a-machine num-steps) (let*-values([(a-machine num-steps)
(run (new-machine (run-compiler 'code)) options ...)] (run (new-machine (run-compiler code)) options ...)]
[(actual) (machine-val a-machine)]) [(actual) (machine-val a-machine)])
(unless (equal? actual exp) (unless (equal? actual exp)
(raise-syntax-error #f (format "Expected ~s, got ~s" exp actual) (raise-syntax-error #f (format "Expected ~s, got ~s" exp actual)
@ -40,12 +40,12 @@
(with-syntax ([stx stx]) (with-syntax ([stx stx])
(syntax/loc #'stx (syntax/loc #'stx
(begin (begin
(printf "Running/exn ~s ...\n" 'code) (printf "Running/exn ~s ...\n" code)
(let/ec return (let/ec return
(with-handlers ([exn:fail? (lambda (exn) (with-handlers ([exn:fail? (lambda (exn)
(printf "ok\n\n") (printf "ok\n\n")
(return))]) (return))])
(run (new-machine (run-compiler 'code)) options ...)) (run (new-machine (run-compiler code)) options ...))
(raise-syntax-error #f (format "Expected an exception") (raise-syntax-error #f (format "Expected an exception")
#'stx)))))])) #'stx)))))]))
@ -82,82 +82,82 @@
;; Atomic expressions ;; Atomic expressions
(test 42 42) (test '42 42)
(test "hello world" "hello world") (test '"hello world" "hello world")
(test #t true) (test '#t true)
(test #f false) (test '#f false)
;; quoted ;; quoted
(test '(+ 3 4) (test ''(+ 3 4)
'(+ 3 4)) '(+ 3 4))
;; Simple definitions ;; Simple definitions
(test (begin (define x 42) (test '(begin (define x 42)
(+ x x)) (+ x x))
84) 84)
(test (begin (define x 6) (test '(begin (define x 6)
(define y 7) (define y 7)
(define z 8) (define z 8)
(* x y z)) (* x y z))
(* 6 7 8)) (* 6 7 8))
;; Simple branching ;; Simple branching
(test (if #t 'ok 'not-ok) (test '(if #t 'ok 'not-ok)
'ok) 'ok)
(test (if #f 'not-ok 'ok) (test '(if #f 'not-ok 'ok)
'ok) 'ok)
;; Sequencing ;; Sequencing
(test (begin 1 (test '(begin 1
2 2
3) 3)
3) 3)
(test (begin 1) (test '(begin 1)
1) 1)
(test (+ (* 3 4) 5) (test '(+ (* 3 4) 5)
17) 17)
;; Square ;; Square
(test (begin (define (f x) (test '(begin (define (f x)
(* x x)) (* x x))
(f 3)) (f 3))
9) 9)
;; Other simple expressions ;; Other simple expressions
(test (+ 137 349) (test '(+ 137 349)
486) 486)
(test (/ 10 5) (test '(/ 10 5)
2) 2)
;; composition of square ;; composition of square
(test (begin (define (f x) (test '(begin (define (f x)
(* x x)) (* x x))
(f (f 3))) (f (f 3)))
81) 81)
(test (begin (define pi 3.14159) (test '(begin (define pi 3.14159)
(define radius 10) (define radius 10)
(* pi (* radius radius))) (* pi (* radius radius)))
314.159) 314.159)
(test (begin (define pi 3.14159) (test '(begin (define pi 3.14159)
(define radius 10) (define radius 10)
(define circumference (* 2 pi radius)) (define circumference (* 2 pi radius))
circumference) circumference)
62.8318) 62.8318)
;; Slightly crazy expression ;; Slightly crazy expression
(test (begin (define (f x) (test '(begin (define (f x)
(* x x)) (* x x))
(define (g x) (define (g x)
(* x x x)) (* x x x))
@ -168,50 +168,50 @@
;; Simple application ;; Simple application
(test ((lambda (x) x) 42) (test '((lambda (x) x) 42)
42) 42)
(test ((lambda (x) (test '((lambda (x)
(begin (* x x))) 42) (begin (* x x))) 42)
1764) 1764)
(test ((lambda (x y z) x) 3 4 5) (test '((lambda (x y z) x) 3 4 5)
3) 3)
(test ((lambda (x y z) y) 3 4 5) (test '((lambda (x y z) y) 3 4 5)
4) 4)
(test ((lambda (x y z) z) 3 4 5) (test '((lambda (x y z) z) 3 4 5)
5) 5)
;; And this should fail because it's not a lambda ;; And this should fail because it's not a lambda
(test/exn (not-a-procedure 5)) (test/exn '(not-a-procedure 5))
;; We should see an error here, since the arity is wrong ;; We should see an error here, since the arity is wrong
(test/exn ((lambda (x y z) x) 3)) (test/exn '((lambda (x y z) x) 3))
(test/exn ((lambda (x y z) z) 3)) (test/exn '((lambda (x y z) z) 3))
(test/exn ((lambda (x y z) x) 3 4 5 6)) (test/exn '((lambda (x y z) x) 3 4 5 6))
; factorial ; factorial
(test (begin (define (f x) (test '(begin (define (f x)
(if (= x 0) (if (= x 0)
1 1
(* x (f (sub1 x))))) (* x (f (sub1 x)))))
(f 0)) (f 0))
1) 1)
(test (begin (define (f x) (test '(begin (define (f x)
(if (= x 0) (if (= x 0)
1 1
(* x (f (sub1 x))))) (* x (f (sub1 x)))))
(f 1)) (f 1))
1) 1)
(test (begin (define (f x) (test '(begin (define (f x)
(if (= x 0) (if (= x 0)
1 1
(* x (f (sub1 x))))) (* x (f (sub1 x)))))
(f 2)) (f 2))
2) 2)
(test (begin (define (f x) (test '(begin (define (f x)
(if (= x 0) (if (= x 0)
1 1
(* x (f (sub1 x))))) (* x (f (sub1 x)))))
@ -223,7 +223,7 @@
;; Tail calling behavior: watch that the stack never grows beyond 8. ;; Tail calling behavior: watch that the stack never grows beyond 8.
(test (begin (define (f x acc) (test '(begin (define (f x acc)
(if (= x 0) (if (= x 0)
acc acc
(f (sub1 x) (* x acc)))) (f (sub1 x) (* x acc))))
@ -237,7 +237,7 @@
;; And from experimental testing, anything below 7 will break. ;; And from experimental testing, anything below 7 will break.
(test/exn (begin (define (f x acc) (test/exn '(begin (define (f x acc)
(if (= x 0) (if (= x 0)
acc acc
(f (sub1 x) (* x acc)))) (f (sub1 x) (* x acc))))
@ -253,7 +253,7 @@
;; tak test ;; tak test
(test (begin (define (tak x y z) (test '(begin (define (tak x y z)
(if (>= y x) (if (>= y x)
z z
(tak (tak (- x 1) y z) (tak (tak (- x 1) y z)
@ -264,7 +264,7 @@
;; deriv ;; deriv
(test (begin (define (deriv-aux a) (list '/ (deriv a) a)) (test '(begin (define (deriv-aux a) (list '/ (deriv a) a))
(define (map f l) (define (map f l)
(if (null? l) (if (null? l)
l l
@ -301,7 +301,7 @@
0)) 0))
;; Foldl ;; Foldl
(test (begin (define (foldl f acc lst) (test '(begin (define (foldl f acc lst)
(if (null? lst) (if (null? lst)
acc acc
(foldl f (f (car lst) acc) (cdr lst)))) (foldl f (f (car lst) acc) (cdr lst))))
@ -314,7 +314,7 @@
;; iterating, with some crazy expressions ;; iterating, with some crazy expressions
(test (begin (define (iterate f x n) (test '(begin (define (iterate f x n)
(if (= n 0) (if (= n 0)
x x
(iterate f (f x) (sub1 n)))) (iterate f (f x) (sub1 n))))
@ -330,7 +330,7 @@
(list 160000 1001 42)) (list 160000 1001 42))
;; Trying out closures ;; Trying out closures
(test (begin (test '(begin
(define delta 1) (define delta 1)
(define (diff f) (define (diff f)
(lambda (x) (lambda (x)
@ -345,13 +345,13 @@
(test (begin (define (square x) (test '(begin (define (square x)
(* x x)) (* x x))
(square (square 3))) (square (square 3)))
81) 81)
(test (begin (define (square x) (test '(begin (define (square x)
(* x x)) (* x x))
(define (sum-of-squares x y) (define (sum-of-squares x y)
(+ (square x) (square y))) (+ (square x) (square y)))
@ -359,7 +359,7 @@
25) 25)
(test (begin (define (sqrt-iter guess x) (test '(begin (define (sqrt-iter guess x)
(if (good-enough? guess x) (if (good-enough? guess x)
guess guess
(sqrt-iter (improve guess x) (sqrt-iter (improve guess x)
@ -384,7 +384,7 @@
'(3.00009155413138 154.73202642085838 177.02259745919164)) '(3.00009155413138 154.73202642085838 177.02259745919164))
;; fibonacci ;; fibonacci
(test (begin (define (fib n) (test '(begin (define (fib n)
(if (= n 0) 0 (if (= n 0) 0
(if (= n 1) 1 (if (= n 1) 1
(+ (fib (- n 1)) (+ (fib (- n 1))
@ -393,7 +393,7 @@
55) 55)
;; Fibonacci, iterative. This should be computable while using at most 10 spots. ;; Fibonacci, iterative. This should be computable while using at most 10 spots.
(test (begin (test '(begin
(define (fib n) (define (fib n)
(fib-iter 1 0 n)) (fib-iter 1 0 n))
@ -411,14 +411,14 @@
;; Exponentiation ;; Exponentiation
(test (begin (define (expt b n) (test '(begin (define (expt b n)
(if (= n 0) (if (= n 0)
1 1
(* b (expt b (- n 1))))) (* b (expt b (- n 1)))))
(expt 2 30)) (expt 2 30))
(expt 2 30)) (expt 2 30))
(test (begin (test '(begin
(define (expt b n) (define (expt b n)
(expt-iter b n 1)) (expt-iter b n 1))
@ -431,7 +431,7 @@
(expt 2 30)) (expt 2 30))
(expt 2 30)) (expt 2 30))
(test (begin (test '(begin
(define (fast-expt b n) (define (fast-expt b n)
(cond ((= n 0) 1) (cond ((= n 0) 1)
((even? n) (square (fast-expt b (/ n 2)))) ((even? n) (square (fast-expt b (/ n 2))))
@ -449,7 +449,7 @@
(expt 2 23984000))) (expt 2 23984000)))
(test (begin (define (length l) (test '(begin (define (length l)
(if (null? l) (if (null? l)
0 0
(+ 1 (length (cdr l))))) (+ 1 (length (cdr l)))))
@ -460,7 +460,7 @@
(void)) (void))
(test (begin (define (sum-integers a b) (test '(begin (define (sum-integers a b)
(if (> a b) (if (> a b)
0 0
(+ a (sum-integers (+ a 1) b)))) (+ a (sum-integers (+ a 1) b))))
@ -468,7 +468,7 @@
(* 50 101)) (* 50 101))
(test (begin (define (sum term a next b) (test '(begin (define (sum term a next b)
(if (> a b) (if (> a b)
0 0
(+ (term a) (+ (term a)
@ -483,16 +483,16 @@
(sum-integers 1 10))) (sum-integers 1 10)))
(list 3025 55)) (list 3025 55))
(test (let () 5) 5) (test '(let () 5) 5)
(test (let* ([x 3] (test '(let* ([x 3]
[y 4] [y 4]
[z 17]) [z 17])
(+ x y z)) (+ x y z))
24) 24)
(test (list (let* ([x 3] (test '(list (let* ([x 3]
[y (+ x 1)] [y (+ x 1)]
[z (+ x y)]) [z (+ x y)])
(list x y z)) (list x y z))
@ -501,7 +501,7 @@
4)) 4))
(test (list (let* ([x 3] (test '(list (let* ([x 3]
[y (+ x 1)] [y (+ x 1)]
[z (+ x y)]) [z (+ x y)])
(list x y z)) (list x y z))
@ -512,14 +512,14 @@
(list (list 3 4 7) (list (list 3 4 7)
(list 17 18 35))) (list 17 18 35)))
(test (let* ([x 0] (test '(let* ([x 0]
[x (add1 x)] [x (add1 x)]
[x (add1 x)]) [x (add1 x)])
x) x)
2) 2)
(test (begin (test '(begin
(define (sum-iter x acc) (define (sum-iter x acc)
(if (= x 0) (if (= x 0)
acc acc
@ -532,12 +532,12 @@
#:control-limit 1) #:control-limit 1)
(test (let ([x 16]) (test '(let ([x 16])
(call/cc (lambda (k) (+ x x)))) (call/cc (lambda (k) (+ x x))))
32) 32)
(test (add1 (let ([x 16]) (test '(add1 (let ([x 16])
(call/cc (lambda (k) (call/cc (lambda (k)
(k 0) (k 0)
(+ x x))))) (+ x x)))))
@ -547,7 +547,7 @@
;; Reference: http://lists.racket-lang.org/users/archive/2009-January/029812.html ;; Reference: http://lists.racket-lang.org/users/archive/2009-January/029812.html
(let ([op (open-output-string)]) (let ([op (open-output-string)])
(parameterize ([current-simulated-output-port op]) (parameterize ([current-simulated-output-port op])
(test (begin (define program (lambda () (test '(begin (define program (lambda ()
(let ((y (call/cc (lambda (c) c)))) (let ((y (call/cc (lambda (c) c))))
(display 1) (display 1)
(call/cc (lambda (c) (y c))) (call/cc (lambda (c) (y c)))
@ -564,7 +564,7 @@
;; ctak ;; ctak
(test (begin (test '(begin
(define (ctak x y z) (define (ctak x y z)
(call-with-current-continuation (call-with-current-continuation
(lambda (k) (lambda (k)
@ -598,7 +598,7 @@
7) 7)
(test (let ([x 3] (test '(let ([x 3]
[y 4]) [y 4])
(let ([x y] (let ([x y]
[y x]) [y x])
@ -606,14 +606,14 @@
(list 4 3)) (list 4 3))
(test (letrec ([f (lambda (x) (test '(letrec ([f (lambda (x)
(if (= x 0) (if (= x 0)
1 1
(* x (f (sub1 x)))))]) (* x (f (sub1 x)))))])
(f 10)) (f 10))
3628800) 3628800)
(test (letrec ([e (lambda (x) (test '(letrec ([e (lambda (x)
(if (= x 0) (if (= x 0)
#t #t
(o (sub1 x))))] (o (sub1 x))))]
@ -628,7 +628,8 @@
(test (read (open-input-file "tests/conform/program0.sch"))
(port->string (open-input-file "tests/conform/expected0.txt")))
;(simulate (compile (parse '42) 'val 'next)) ;(simulate (compile (parse '42) 'val 'next))
;(compile (parse '(+ 3 4)) 'val 'next) ;(compile (parse '(+ 3 4)) 'val 'next)

65
test-conform.rkt Normal file
View File

@ -0,0 +1,65 @@
#lang racket
(require "simulator.rkt"
"simulator-structs.rkt"
"compile.rkt"
"parse.rkt")
(define (run-compiler code)
(compile (parse code) 'val 'next))
;; run: machine -> (machine number)
;; Run the machine to completion.
(define (run m
#:debug? (debug? false)
#:stack-limit (stack-limit false)
#:control-limit (control-limit false))
(let loop ([steps 0])
(when debug?
(when (can-step? m)
(printf "|env|=~s, |control|=~s, instruction=~s\n"
(length (machine-env m))
(length (machine-control m))
(current-instruction m))))
(when stack-limit
(when (> (machine-stack-size m) stack-limit)
(error 'run "Stack overflow")))
(when control-limit
(when (> (machine-control-size m) control-limit)
(error 'run "Control overflow")))
(cond
[(can-step? m)
(step! m)
(loop (add1 steps))]
[else
(values m steps)])))
;; Test out the compiler, using the simulator.
(define-syntax (test stx)
(syntax-case stx ()
[(_ code exp options ...)
(with-syntax ([stx stx])
(syntax/loc #'stx
(begin
(printf "Running... \n")
(let*-values([(a-machine num-steps)
(run (new-machine (run-compiler code)) options ...)]
[(actual) (machine-val a-machine)])
(unless (equal? actual exp)
(raise-syntax-error #f (format "Expected ~s, got ~s" exp actual)
#'stx))
(unless (= (machine-stack-size a-machine) 1)
(raise-syntax-error #f (format "Stack is not back to the prefix as expected!")
#'stx))
(unless (null? (machine-control a-machine))
(raise-syntax-error #f (format "Control is not empty as expected!")
#'stx))
(printf "ok. ~s steps.\n\n" num-steps)))))]))
(test (read (open-input-file "tests/conform/program0.sch"))
(port->string (open-input-file "tests/conform/expected0.txt")))