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

simulator's running deriv in simulator, and producing the right results. huzzah.

Browse Source
This commit is contained in:
Danny Yoo 2011-03-08 04:01:10 -05:00
parent 5307871a46
commit 393e0707e1
2 changed files with 42 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
simulator-prims.rkt
View File

@ -32,5 +32,9 @@
(provide lookup-primitive) (provide lookup-primitive)
(define lookup-primitive (make-lookup #:functions (+ - * / = < <= > >= cons list car cdr (define lookup-primitive (make-lookup #:functions (+ - * / = < <= > >= cons list car cdr
sub1 sub1
display newline displayln) display newline displayln
not
pair?
eq?
null?)
#:constants (null pi e))) #:constants (null pi e)))

37
test-compiler.rkt
View File

@ -206,6 +206,7 @@
(f 1000)) (f 1000))
#:stack-limit 8) #:stack-limit 8)
;; 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)
@ -233,6 +234,42 @@
7) 7)
;; 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)))
'(+ (* (* 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))
;(simulate (compile (parse '42) 'val 'next)) ;(simulate (compile (parse '42) 'val 'next))