From 2bb72b6c4424aef134c40005e7352ae8a2b23d12 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Thu, 12 May 2011 02:33:31 -0400 Subject: [PATCH] trying to trace why test-compiler is failing on the derivative example. Something broke. --- bootstrapped-primitives.rkt | 9 ++- kernel-primitives.rkt | 18 ++++- simulator-primitives.rkt | 10 +++ test-compiler.rkt | 153 +++++++++++++++++++----------------- 4 files changed, 113 insertions(+), 77 deletions(-) diff --git a/bootstrapped-primitives.rkt b/bootstrapped-primitives.rkt index 83e77df..bb05fa8 100644 --- a/bootstrapped-primitives.rkt +++ b/bootstrapped-primitives.rkt @@ -148,8 +148,13 @@ l2 (cons (car l1) (append-2 (cdr l1) l2))))]) (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: diff --git a/kernel-primitives.rkt b/kernel-primitives.rkt index 584da46..04e907d 100644 --- a/kernel-primitives.rkt +++ b/kernel-primitives.rkt @@ -18,6 +18,7 @@ '/ 'add1 'sub1 + 'abs '< '<= '= @@ -26,10 +27,25 @@ 'cons 'car 'cdr + 'cadr + 'caddr 'list + 'pair? 'null? 'not '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) @@ -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. ;; TODO: do something more polymorphic. (define (kernel-primitive-expected-operand-types prim arity) diff --git a/simulator-primitives.rkt b/simulator-primitives.rkt index 498e1b0..afa5269 100644 --- a/simulator-primitives.rkt +++ b/simulator-primitives.rkt @@ -79,6 +79,14 @@ (define my-cdr (lambda (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) (MutablePair? x))) @@ -227,6 +235,8 @@ (my-list list) (my-car car) (my-cdr cdr) + (my-cadr cadr) + (my-caddr caddr) (my-pair? pair?) (my-set-car! set-car!) (my-set-cdr! set-cdr!) diff --git a/test-compiler.rkt b/test-compiler.rkt index 964c17c..8f36827 100644 --- a/test-compiler.rkt +++ b/test-compiler.rkt @@ -108,11 +108,11 @@ '(+ 3 4)) ;; Simple definitions -(test '(begin (define x 42) +(test '(let () (define x 42) (+ x x)) 84) -(test '(begin (define x 6) +(test '(let () (define x 6) (define y 7) (define z 8) (* x y z)) @@ -164,24 +164,24 @@ 1) ;; composition of square -(test '(begin (define (f x) +(test '(let () (define (f x) (* x x)) (f (f 3))) 81) -(test '(begin (define pi 3.14159) +(test '(let () (define pi 3.14159) (define radius 10) (* pi (* radius radius))) 314.159) -(test '(begin (define pi 3.14159) +(test '(let () (define pi 3.14159) (define radius 10) (define circumference (* 2 pi radius)) circumference) 62.8318) ;; Slightly crazy expression -(test '(begin (define (f x) +(test '(let () (define (f x) (* x x)) (define (g x) (* x x x)) @@ -216,26 +216,26 @@ ; factorial -(test '(begin (define (f x) +(test '(let () (define (f x) (if (= x 0) 1 (* x (f (sub1 x))))) (f 0)) 1) -(test '(begin (define (f x) +(test '(let () (define (f x) (if (= x 0) 1 (* x (f (sub1 x))))) (f 1)) 1) -(test '(begin (define (f x) +(test '(let () (define (f x) (if (= x 0) 1 (* x (f (sub1 x))))) (f 2)) 2) -(test '(begin (define (f x) +(test '(let () (define (f x) (if (= x 0) 1 (* x (f (sub1 x))))) @@ -246,8 +246,8 @@ -;; Tail calling behavior: watch that the stack never grows beyond 8. -(test '(begin (define (f x acc) +;; Tail calling behavior: watch that the stack never grows beyond some ceiling. +(test '(let () (define (f x acc) (if (= x 0) acc (f (sub1 x) (* x acc)))) @@ -258,11 +258,13 @@ (* x (f (sub1 x)))))]) (f 1000)) #:control-limit 3 - #:stack-limit 8) + #:stack-limit 15 + ;;#:debug? #t + ) ;; 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) acc (f (sub1 x) (* x acc)))) @@ -289,7 +291,7 @@ f)) (list 42 43)) -(test '(begin (define (m f l) +(test '(let () (define (m f l) (if (null? l) l (cons (f (car l)) @@ -308,7 +310,7 @@ -(test '(begin +(test '(let () (define (foo y) y) (define (sum-iter x acc) @@ -320,58 +322,60 @@ (sum-iter y z)))) (sum-iter 300 0)) 45150 - #:stack-limit 8 + #:stack-limit 20 #:control-limit 4) ;; deriv -(test '(begin (define (deriv-aux a) (list '/ (deriv a) a)) - (define (map f l) - (if (null? l) - l - (cons (f (car l)) - (map f (cdr l))))) - (define (deriv a) - (if (not (pair? a)) - (if (eq? a 'x) 1 0) - (if (eq? (car a) '+) - (cons '+ (map deriv (cdr a))) - (if (eq? (car a) '-) - (cons '- (map deriv - (cdr a))) - (if (eq? (car a) '*) - (list '* - a - (cons '+ (map deriv-aux (cdr a)))) - (if (eq? (car a) '/) - (list '- - (list '/ - (deriv (cadr a)) - (caddr a)) - (list '/ - (cadr a) - (list '* - (caddr a) - (caddr a) - (deriv (caddr a))))) - 'error)))))) - (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))) +(test '(let () + (define (deriv-aux a) (list '/ (deriv a) a)) + (define (map f l) + (if (null? l) + l + (cons (f (car l)) + (map f (cdr l))))) + (define (deriv a) + (if (not (pair? a)) + (if (eq? a 'x) 1 0) + (if (eq? (car a) '+) + (cons '+ (map deriv (cdr a))) + (if (eq? (car a) '-) + (cons '- (map deriv + (cdr a))) + (if (eq? (car a) '*) + (list '* + a + (cons '+ (map deriv-aux (cdr a)))) + (if (eq? (car a) '/) + (list '- + (list '/ + (deriv (cadr a)) + (caddr a)) + (list '/ + (cadr a) + (list '* + (caddr a) + (caddr a) + (deriv (caddr a))))) + 'error)))))) + (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))) '(+ (* (* 3 x x) (+ (/ 0 3) (/ 1 x) (/ 1 x))) (* (* a x x) (+ (/ 0 a) (/ 1 x) (/ 1 x))) (* (* b x) (+ (/ 0 b) (/ 1 x))) 0)) ;; Foldl -(test '(begin (define (foldl f acc lst) - (if (null? lst) - acc - (foldl f (f (car lst) acc) (cdr lst)))) - (foldl (lambda (x acc) - (* x acc)) - 1 - '(1 2 3 4 5 6 7 8 9 10))) +(test '(let() + (define (foldl f acc lst) + (if (null? lst) + acc + (foldl f (f (car lst) acc) (cdr lst)))) + (foldl (lambda (x acc) + (* x acc)) + 1 + '(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) -(test '(begin (define (sqrt-iter guess x) +(test '(let() (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) @@ -451,14 +455,14 @@ ;; Exponentiation -(test '(begin (define (expt b n) +(test '(let () (define (expt b n) (if (= n 0) 1 (* b (expt b (- n 1))))) (expt 2 30)) (expt 2 30)) -(test '(begin +(test '(let () (define (expt b n) (expt-iter b n 1)) @@ -471,7 +475,7 @@ (expt 2 30)) (expt 2 30)) -(test '(begin +(test '(let() (define (fast-expt b n) (cond ((= n 0) 1) ((even? n) (square (fast-expt b (/ n 2)))) @@ -489,7 +493,7 @@ (expt 2 23984000))) -(test '(begin (define (length l) +(test '(let () (define (length l) (if (null? l) 0 (+ 1 (length (cdr l))))) @@ -501,7 +505,7 @@ -(test '(begin (define (f x) +(test '(let () (define (f x) (* x x)) (f 3) (f 4) @@ -509,7 +513,7 @@ 25) -(test '(begin (define (sum-integers a b) +(test '(let () (define (sum-integers a b) (if (> a b) 0 (+ a (sum-integers (+ a 1) b)))) @@ -517,7 +521,7 @@ (* 50 101)) -(test '(begin (define (sum term a next b) +(test '(let () (define (sum term a next b) (if (> a b) 0 (+ (term a) @@ -534,7 +538,7 @@ ;; Lexical scope bug: make sure that parameters shadow toplevels. -(test '(begin +(test '(let () (define x 42) (define (f x) (+ x 1)) @@ -611,9 +615,9 @@ ;; 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]) - (test '(begin (define program (lambda () + (test '(let () (define program (lambda () (let ((y (call/cc (lambda (c) c)))) (display 1) (call/cc (lambda (c) (y c))) @@ -770,7 +774,7 @@ "gee!")]) (a)) "gee!" - #:stack-limit 9 + #:stack-limit 20 #:control-limit 2) @@ -793,7 +797,7 @@ "ho!")]) (a)) "gee!" - #:stack-limit 12 + #:stack-limit 20 #:control-limit 2) @@ -815,7 +819,7 @@ (cons "gee!" lst))]) (a '())) '("gee!" "f" "e" "d" "c" "b" "a") - #:stack-limit 12 + #:stack-limit 20 #:control-limit 2) @@ -832,7 +836,7 @@ (sum-iter y z))))]) (sum-iter 300 0)) 45150 - #:stack-limit 10 + #:stack-limit 20 #:control-limit 3) @@ -879,7 +883,7 @@ (define n 0) (call/cc (lambda (x) (set! cont x))) (set! n (add1 n)) - (if (< n 10) + (when (< n 10) (cont 'dontcare)) n) (f)) @@ -894,7 +898,7 @@ (define n 0) (call/cc (lambda (x) (set! cont x))) (set! n (add1 n)) - (if (< n 10) + (when (< n 10) (cont 'dontcare)) n) 1 @@ -1026,7 +1030,7 @@ (apply sum-iter (list y z)))))]) (sum-iter 300 0)) 45150 - #:stack-limit 10 + #:stack-limit 20 #:control-limit 3 #:with-bootstrapping? #t) @@ -1179,6 +1183,7 @@ '(1 2) #:with-bootstrapping? #t) + (test '(call-with-values * -) -1 #:with-bootstrapping? #t)