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

trying to trace why test-compiler is failing on the derivative example. Something broke.

Browse Source
This commit is contained in:
Danny Yoo 2011-05-12 02:33:31 -04:00
parent 03164578a4
commit 2bb72b6c44
4 changed files with 113 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
bootstrapped-primitives.rkt
View File

@ -148,8 +148,13 @@
l2 l2
(cons (car l1) (append-2 (cdr l1) l2))))]) (cons (car l1) (append-2 (cdr l1) l2))))])
(lambda args (append-many args)))) (lambda args (append-many args))))
(make-bootstrapped-primitive-code
'call-with-values
'(lambda (producer consumer)
(call-with-values (lambda () (producer)) consumer)))
;; The call/cc code is special: ;; The call/cc code is special:

18
kernel-primitives.rkt
View File

@ -18,6 +18,7 @@
'/ '/
'add1 'add1
'sub1 'sub1
'abs
'< '<
'<= '<=
'= '=
@ -26,10 +27,25 @@
'cons 'cons
'car 'car
'cdr 'cdr
'cadr
'caddr
'list 'list
'pair?
'null? 'null?
'not 'not
'eq? 'eq?
'remainder
'display
'newline
'call/cc
'box
'unbox
'set-box!
'string-append
'current-continuation-marks
'continuation-mark-set->list
'values
'call-with-values
)) ))
(define-predicate KernelPrimitiveName? KernelPrimitiveName) (define-predicate KernelPrimitiveName? KernelPrimitiveName)
@ -57,7 +73,7 @@
(: kernel-primitive-expected-operand-types (KernelPrimitiveName Natural -> (Listof OperandDomain))) (: kernel-primitive-expected-operand-types (KernelPrimitiveName/Inline Natural -> (Listof OperandDomain)))
;; Given a primitive and the number of arguments, produces the list of expected domains. ;; Given a primitive and the number of arguments, produces the list of expected domains.
;; TODO: do something more polymorphic. ;; TODO: do something more polymorphic.
(define (kernel-primitive-expected-operand-types prim arity) (define (kernel-primitive-expected-operand-types prim arity)

10
simulator-primitives.rkt
View File

@ -79,6 +79,14 @@
(define my-cdr (lambda (x) (define my-cdr (lambda (x)
(MutablePair-t x))) (MutablePair-t x)))
(define my-cadr (lambda (x)
(MutablePair-h (MutablePair-t x))))
(define my-caddr (lambda (x)
(MutablePair-h (MutablePair-t (MutablePair-t x)))))
(define my-pair? (lambda (x) (define my-pair? (lambda (x)
(MutablePair? x))) (MutablePair? x)))
@ -227,6 +235,8 @@
(my-list list) (my-list list)
(my-car car) (my-car car)
(my-cdr cdr) (my-cdr cdr)
(my-cadr cadr)
(my-caddr caddr)
(my-pair? pair?) (my-pair? pair?)
(my-set-car! set-car!) (my-set-car! set-car!)
(my-set-cdr! set-cdr!) (my-set-cdr! set-cdr!)

153
test-compiler.rkt
View File

@ -108,11 +108,11 @@
'(+ 3 4)) '(+ 3 4))
;; Simple definitions ;; Simple definitions
(test '(begin (define x 42) (test '(let () (define x 42)
(+ x x)) (+ x x))
84) 84)
(test '(begin (define x 6) (test '(let () (define x 6)
(define y 7) (define y 7)
(define z 8) (define z 8)
(* x y z)) (* x y z))
@ -164,24 +164,24 @@
1) 1)
;; composition of square ;; composition of square
(test '(begin (define (f x) (test '(let () (define (f x)
(* x x)) (* x x))
(f (f 3))) (f (f 3)))
81) 81)
(test '(begin (define pi 3.14159) (test '(let () (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 '(let () (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 '(let () (define (f x)
(* x x)) (* x x))
(define (g x) (define (g x)
(* x x x)) (* x x x))
@ -216,26 +216,26 @@
; factorial ; factorial
(test '(begin (define (f x) (test '(let () (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 '(let () (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 '(let () (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 '(let () (define (f x)
(if (= x 0) (if (= x 0)
1 1
(* x (f (sub1 x))))) (* x (f (sub1 x)))))
@ -246,8 +246,8 @@
;; Tail calling behavior: watch that the stack never grows beyond 8. ;; Tail calling behavior: watch that the stack never grows beyond some ceiling.
(test '(begin (define (f x acc) (test '(let () (define (f x acc)
(if (= x 0) (if (= x 0)
acc acc
(f (sub1 x) (* x acc)))) (f (sub1 x) (* x acc))))
@ -258,11 +258,13 @@
(* x (f (sub1 x)))))]) (* x (f (sub1 x)))))])
(f 1000)) (f 1000))
#:control-limit 3 #:control-limit 3
#:stack-limit 8) #:stack-limit 15
;;#:debug? #t
)
;; 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 '(let () (define (f x acc)
(if (= x 0) (if (= x 0)
acc acc
(f (sub1 x) (* x acc)))) (f (sub1 x) (* x acc))))
@ -289,7 +291,7 @@
f)) f))
(list 42 43)) (list 42 43))
(test '(begin (define (m f l) (test '(let () (define (m f l)
(if (null? l) (if (null? l)
l l
(cons (f (car l)) (cons (f (car l))
@ -308,7 +310,7 @@
(test '(begin (test '(let ()
(define (foo y) (define (foo y)
y) y)
(define (sum-iter x acc) (define (sum-iter x acc)
@ -320,58 +322,60 @@
(sum-iter y z)))) (sum-iter y z))))
(sum-iter 300 0)) (sum-iter 300 0))
45150 45150
#:stack-limit 8 #:stack-limit 20
#:control-limit 4) #:control-limit 4)
;; deriv ;; deriv
(test '(begin (define (deriv-aux a) (list '/ (deriv a) a)) (test '(let ()
(define (map f l) (define (deriv-aux a) (list '/ (deriv a) a))
(if (null? l) (define (map f l)
l (if (null? l)
(cons (f (car l)) l
(map f (cdr l))))) (cons (f (car l))
(define (deriv a) (map f (cdr l)))))
(if (not (pair? a)) (define (deriv a)
(if (eq? a 'x) 1 0) (if (not (pair? a))
(if (eq? (car a) '+) (if (eq? a 'x) 1 0)
(cons '+ (map deriv (cdr a))) (if (eq? (car a) '+)
(if (eq? (car a) '-) (cons '+ (map deriv (cdr a)))
(cons '- (map deriv (if (eq? (car a) '-)
(cdr a))) (cons '- (map deriv
(if (eq? (car a) '*) (cdr a)))
(list '* (if (eq? (car a) '*)
a (list '*
(cons '+ (map deriv-aux (cdr a)))) a
(if (eq? (car a) '/) (cons '+ (map deriv-aux (cdr a))))
(list '- (if (eq? (car a) '/)
(list '/ (list '-
(deriv (cadr a)) (list '/
(caddr a)) (deriv (cadr a))
(list '/ (caddr a))
(cadr a) (list '/
(list '* (cadr a)
(caddr a) (list '*
(caddr a) (caddr a)
(deriv (caddr a))))) (caddr a)
'error)))))) (deriv (caddr a)))))
(deriv '(+ (* 3 x x) (* a x x) (* b x) 5))) 'error))))))
(deriv '(+ (* 3 x x) (* a x x) (* b x) 5)))
'(+ (* (* 3 x x) (+ (/ 0 3) (/ 1 x) (/ 1 x))) '(+ (* (* 3 x x) (+ (/ 0 3) (/ 1 x) (/ 1 x)))
(* (* a x x) (+ (/ 0 a) (/ 1 x) (/ 1 x))) (* (* a x x) (+ (/ 0 a) (/ 1 x) (/ 1 x)))
(* (* b x) (+ (/ 0 b) (/ 1 x))) (* (* b x) (+ (/ 0 b) (/ 1 x)))
0)) 0))
;; Foldl ;; Foldl
(test '(begin (define (foldl f acc lst) (test '(let()
(if (null? lst) (define (foldl f acc lst)
acc (if (null? lst)
(foldl f (f (car lst) acc) (cdr lst)))) acc
(foldl (lambda (x acc) (foldl f (f (car lst) acc) (cdr lst))))
(* x acc)) (foldl (lambda (x acc)
1 (* x acc))
'(1 2 3 4 5 6 7 8 9 10))) 1
'(1 2 3 4 5 6 7 8 9 10)))
(* 1 2 3 4 5 6 7 8 9 10)) (* 1 2 3 4 5 6 7 8 9 10))
@ -422,7 +426,7 @@
25) 25)
(test '(begin (define (sqrt-iter guess x) (test '(let() (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)
@ -451,14 +455,14 @@
;; Exponentiation ;; Exponentiation
(test '(begin (define (expt b n) (test '(let () (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 '(let ()
(define (expt b n) (define (expt b n)
(expt-iter b n 1)) (expt-iter b n 1))
@ -471,7 +475,7 @@
(expt 2 30)) (expt 2 30))
(expt 2 30)) (expt 2 30))
(test '(begin (test '(let()
(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))))
@ -489,7 +493,7 @@
(expt 2 23984000))) (expt 2 23984000)))
(test '(begin (define (length l) (test '(let () (define (length l)
(if (null? l) (if (null? l)
0 0
(+ 1 (length (cdr l))))) (+ 1 (length (cdr l)))))
@ -501,7 +505,7 @@
(test '(begin (define (f x) (test '(let () (define (f x)
(* x x)) (* x x))
(f 3) (f 3)
(f 4) (f 4)
@ -509,7 +513,7 @@
25) 25)
(test '(begin (define (sum-integers a b) (test '(let () (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))))
@ -517,7 +521,7 @@
(* 50 101)) (* 50 101))
(test '(begin (define (sum term a next b) (test '(let () (define (sum term a next b)
(if (> a b) (if (> a b)
0 0
(+ (term a) (+ (term a)
@ -534,7 +538,7 @@
;; Lexical scope bug: make sure that parameters shadow toplevels. ;; Lexical scope bug: make sure that parameters shadow toplevels.
(test '(begin (test '(let ()
(define x 42) (define x 42)
(define (f x) (define (f x)
(+ x 1)) (+ x 1))
@ -611,9 +615,9 @@
;; 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 '(let () (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)))
@ -770,7 +774,7 @@
"gee!")]) "gee!")])
(a)) (a))
"gee!" "gee!"
#:stack-limit 9 #:stack-limit 20
#:control-limit 2) #:control-limit 2)
@ -793,7 +797,7 @@
"ho!")]) "ho!")])
(a)) (a))
"gee!" "gee!"
#:stack-limit 12 #:stack-limit 20
#:control-limit 2) #:control-limit 2)
@ -815,7 +819,7 @@
(cons "gee!" lst))]) (cons "gee!" lst))])
(a '())) (a '()))
'("gee!" "f" "e" "d" "c" "b" "a") '("gee!" "f" "e" "d" "c" "b" "a")
#:stack-limit 12 #:stack-limit 20
#:control-limit 2) #:control-limit 2)
@ -832,7 +836,7 @@
(sum-iter y z))))]) (sum-iter y z))))])
(sum-iter 300 0)) (sum-iter 300 0))
45150 45150
#:stack-limit 10 #:stack-limit 20
#:control-limit 3) #:control-limit 3)
@ -879,7 +883,7 @@
(define n 0) (define n 0)
(call/cc (lambda (x) (set! cont x))) (call/cc (lambda (x) (set! cont x)))
(set! n (add1 n)) (set! n (add1 n))
(if (< n 10) (when (< n 10)
(cont 'dontcare)) (cont 'dontcare))
n) n)
(f)) (f))
@ -894,7 +898,7 @@
(define n 0) (define n 0)
(call/cc (lambda (x) (set! cont x))) (call/cc (lambda (x) (set! cont x)))
(set! n (add1 n)) (set! n (add1 n))
(if (< n 10) (when (< n 10)
(cont 'dontcare)) (cont 'dontcare))
n) n)
1 1
@ -1026,7 +1030,7 @@
(apply sum-iter (list y z)))))]) (apply sum-iter (list y z)))))])
(sum-iter 300 0)) (sum-iter 300 0))
45150 45150
#:stack-limit 10 #:stack-limit 20
#:control-limit 3 #:control-limit 3
#:with-bootstrapping? #t) #:with-bootstrapping? #t)
@ -1179,6 +1183,7 @@
'(1 2) '(1 2)
#:with-bootstrapping? #t) #:with-bootstrapping? #t)
(test '(call-with-values * -) (test '(call-with-values * -)
-1 -1
#:with-bootstrapping? #t) #:with-bootstrapping? #t)