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

sync/yield bug, propagate

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/2htdp/private/last.ss
View File

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

3
collects/2htdp/private/launch-many-worlds.ss
View File

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

5
collects/2htdp/uchat/chatter.ss
View File

@ -1,7 +1,7 @@
;; The first three lines of this file were inserted by DrScheme. They record metadata ;; 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. ;; 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 ()))) #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 2htdp/universe)
(require "auxiliaries.ss") (require "auxiliaries.ss")
#| #|
@ -480,5 +480,6 @@
(on-key react) (on-key react)
(on-draw render) (on-draw render)
(on-receive receive) (on-receive receive)
(check-with world?)
(name n) (name n)
(register LOCALHOST))) (register LOCALHOST)))

8
collects/2htdp/universe.ss
View File

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