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

still debugging

Browse Source
This commit is contained in:
dyoo 2011-03-31 14:42:52 -04:00
parent 73015f4116
commit 074be88089
2 changed files with 34 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
compile.rkt
View File

@ -478,11 +478,9 @@
[(operand-knowledge)
(append (map (lambda: ([arg : Expression])
(printf "looking up ~s in ~s\n" arg extended-cenv)
(extract-static-knowledge arg extended-cenv))
constant-operands)
(map (lambda: ([arg : Expression])
(printf "looking up ~s in ~s\n" arg extended-cenv)
(extract-static-knowledge arg extended-cenv))
rest-operands))]
@ -527,19 +525,16 @@
(end-with-linkage
linkage cenv
(append-instruction-sequences
stack-pushing-code
rest-operand-code
(make-instruction-sequence
`(,(make-AssignPrimOpStatement
target
(make-CallKernelPrimitiveProcedure kernel-op
(append constant-operand-poss
rest-operand-poss)
expected-operand-types
typechecks?))))
(make-CallKernelPrimitiveProcedure
kernel-op
(append constant-operand-poss rest-operand-poss)
expected-operand-types
typechecks?))))
stack-popping-code))))

30
test-compiler.rkt
View File

@ -271,7 +271,35 @@
(tak (- z 1) x y))))
(tak 18 12 6))
7)
(test '((let* ([x 42]
[f (lambda () x)])
f))
42)
(test '((let* ([x 42]
[y 43]
[f (lambda () (list x y))])
f))
(list 42 43))
(test '(begin (define (m f l)
(if (null? l)
l
(cons (f (car l))
(m f (cdr l)))))
(m (lambda (x) (add1 x)) '(2 3 4 5)))
'(3 4 5 6))
(test '(+ (+ 3 4)
6)
(+ 3 4 6))
(test '(+ (+ 3 (+ 4 5))
6)
(+ 3 4 5 6))
;; deriv
(test '(begin (define (deriv-aux a) (list '/ (deriv a) a))