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

still chasing

Browse Source
This commit is contained in:
Danny Yoo 2011-09-27 17:03:37 -04:00
parent 2b0d6a2ea8
commit baff56f6d0
2 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compiler/compiler.rkt
View File

@ -1709,6 +1709,7 @@
rhs-code
body-code
after-body-code
;; We want to clear out the scratch space introduced by the
;; let1. However, there may be multiple values coming

24
tests/more-tests/conform.rkt
View File

@ -129,7 +129,13 @@
(define set-internal-node-name! (lambda (node name) (vector-set! node '0 name)))
(define set-internal-node-green-edges! (lambda (node edges) (vector-set! node '1 edges)))
(define set-internal-node-red-edges! (lambda (node edges) (vector-set! node '2 edges)))
(define set-internal-node-blue-edges! (lambda (node edges) (vector-set! node '3 edges)))
(define set-internal-node-blue-edges! (lambda (node edges)
(displayln "in set-internal-node-blue-edges")
(displayln node)
(displayln edges)
(vector-set! node '3 edges)
;(displayln "ok, done")
))
(define make-node
(lambda (name blue-edges)
(let ((name (if (symbol? name) (symbol->string name) name))
@ -149,11 +155,17 @@
(define make-edge-setter
(lambda (mutator!)
(lambda (node value)
(displayln "here")
(displayln any-node?)
(displayln none-node?)
(displayln mutator!)
(if (any-node? node)
(begin (error '"Can't set edges from the ANY node"))
(if (none-node? node) (begin 'OK) (begin (mutator! node value)))))))
(define set-red-edges! (make-edge-setter set-internal-node-red-edges!))
(define set-green-edges! (make-edge-setter set-internal-node-green-edges!))
(displayln make-edge-setter)
(displayln set-internal-node-blue-edges!)
(define set-blue-edges! (make-edge-setter set-internal-node-blue-edges!))
(define make-blue-edge vector)
(define blue-edge-operation (lambda (edge) (vector-ref edge '0)))
@ -464,10 +476,19 @@
(define d '())
(define reset
(lambda ()
(displayln make-node)
(displayln make-blue-edge)
(displayln set-blue-edges!)
(set! a (make-node 'a '()))
(displayln "after make-node")
(set! b (make-node 'b '()))
(displayln "after make-node")
(displayln "blue edge")
(displayln (make-blue-edge 'phi any-node b))
(set-blue-edges! a (list (make-blue-edge 'phi any-node b)))
(displayln "after set-blue-edges!")
(set-blue-edges! b (list (make-blue-edge 'phi any-node a) (make-blue-edge 'theta any-node b)))
(displayln "half")
(set! c (make-node '"c" '()))
(set! d (make-node '"d" '()))
(set-blue-edges! c (list (make-blue-edge 'theta any-node b)))
@ -478,6 +499,7 @@
(define go
(lambda ()
(reset)
(displayln "after reset")
(let ((result
'("(((b v d) ^ a) v c)"
"(c ^ d)"