sync/yield bug, propagate

svn: r15509
This commit is contained in:
Matthias Felleisen 2009-07-20 22:33:49 +00:00
parent bd4395bbfa
commit 574b532e80
4 changed files with 14 additions and 9 deletions

View File

@ -6,6 +6,7 @@
(define last-mixin
(mixin (start-stop<%>) ()
;; to comunicate between stop! and last
(field [end:ch (make-channel)])
;; X -> Void
@ -15,7 +16,7 @@
;; -> World
(define/public (last)
(define result (yield end:ch))
(define result (sync #;yield end:ch)) ;; bug?
(if (exn? result) (raise result) result))
(field [dr:cust (current-custodian)])
@ -24,7 +25,9 @@
;; send x to last method
(define/private (send-to-last x)
(parameterize ((current-custodian dr:cust))
(thread (lambda () (channel-put end:ch x)))))
(thread
(lambda ()
(channel-put end:ch x)))))
(super-new)))

View File

@ -19,8 +19,7 @@
[ch (make-channel)]
[pu (curry channel-put ch)]
[th (map (lambda (th i)
(parameterize ([current-custodian c*]
[current-eventspace (make-eventspace)])
(parameterize ([current-custodian c*])
(rec t
(thread
(lambda ()

View File

@ -1,7 +1,7 @@
;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname chatter) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
(require 2htdp/universe)
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname chatter) (read-case-sensitive #t) (teachpacks ((lib "universe.ss" "teachpack" "2htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "universe.ss" "teachpack" "2htdp")))))
;(require 2htdp/universe)
(require "auxiliaries.ss")
#|
@ -480,5 +480,6 @@
(on-key react)
(on-draw render)
(on-receive receive)
(check-with world?)
(name n)
(register LOCALHOST)))

View File

@ -170,8 +170,9 @@
kwds Spec)))
(list (syntax-e (car co)) ((cadr co) (cdr x))))
spec)])
#`(let ([o (new (if #,rec? aworld% world%) [world0 w] #,@args)])
(send o last)))]))
#`(parameterize ([current-eventspace (make-eventspace)])
(let ([o (new (if #,rec? aworld% world%) [world0 w] #,@args)])
(send o last))))]))
;
@ -320,5 +321,6 @@
[(not (memq 'on-msg domain))
(raise-syntax-error #f "missing on-msg clause" stx)]
[else ; (and (memq #'on-new domain) (memq #'on-msg domain))
#`(send (new universe% [universe0 u] #,@args) last)]))]))
#`(parameterize ([current-eventspace (make-eventspace)])
(send (new universe% [universe0 u] #,@args) last))]))]))