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

2htdp/universe: adjust universe loop to make it a loop

Browse Source 
Neither the body nor handler functions in `with-handlers` are
in tail position with respect to `with-handlers`.
This commit is contained in:
Matthew Flatt 2014-09-29 17:06:15 -06:00
parent e6eba83512
commit 346365f64c
1 changed files with 7 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/htdp-pkgs/htdp-lib/2htdp/private/universe.rkt
View File

@ -164,7 +164,8 @@
(define (loop)
(apply sync
(handle-evt (tcp-accept-evt tcp-listener) add-iworld)
(map(lambda (p) (handle-evt (iworld-in p) (process-message p))) iworlds)))
(map(lambda (p) (handle-evt (iworld-in p) (process-message p))) iworlds))
(loop))
;;; WHERE
(define tcp-listener
(with-handlers ((exn:fail:network? (lambda (x) (stop! x))))
@ -174,23 +175,19 @@
(define in (first in-out))
(define out (second in-out))
;; is it possible to kill the server with lots of bad connections?
(with-handlers ((tcp-eof? (lambda _ (loop)))
(with-handlers ((tcp-eof? (lambda _ (void)))
(exn? (lambda (e)
(printf "process registration failed!\n~a"
(exn-message e))
(loop))))
(exn-message e)))))
(tcp-process-registration
in out (lambda (info) (pnew (create-iworld in out info))))
(loop)))
in out (lambda (info) (pnew (create-iworld in out info))))))
;; IWorld -> [IPort -> Void]
(define (process-message p)
(lambda (in)
(define (disc e)
(pdisconnect p)
(loop))
(pdisconnect p))
(with-handlers ((tcp-eof? disc))
(pmsg p (tcp-receive in))
(loop))))
(pmsg p (tcp-receive in)))))
;; --- go universe go ---
(set! iworlds '())
(send universe set "initial expression" universe0)