Add debug stubs

This commit is contained in:
Tony Garnock-Jones 2012-03-11 13:07:48 -04:00
parent 72c646821c
commit ca2e856660
1 changed files with 4 additions and 0 deletions

View File

@ -132,6 +132,7 @@
(define/public (assert!-evt name)
(define cname (canonicalize name))
;;(write `(handle ,debug-name asserts ,cname)) (newline)
(choice-evt the-disconnected-evt
(wrap-evt (channel-put-evt out-ch (arrived cname))
(lambda (v)
@ -142,6 +143,7 @@
(define/public (retract!-evt name [why #f])
(define cname (canonicalize name))
;;(write `(handle ,debug-name retracts ,cname)) (newline)
(choice-evt the-disconnected-evt
(wrap-evt (channel-put-evt out-ch (departed cname why))
(lambda (v)
@ -273,6 +275,7 @@
(define (insert-flow! b1 topic1 flow topic2 b2)
(when (not (topic-virtual? topic2))
(define old-count (hash-ref (binding-flows b1) flow 0))
;;(write `(count for flow ,flow at ,(binding-debug-name b1) was ,old-count)) (newline)
(when (zero? old-count)
(enqueue-message! b1 (arrived flow)))
(set-binding-flows! b1 (hash-set (binding-flows b1) flow (+ old-count 1))))
@ -287,6 +290,7 @@
(define old-flows (binding-flows b1))
(define old-count (hash-ref old-flows flow)) ;; error if absent
(define new-count (- old-count 1))
;;(write `(count for flow ,flow at ,(binding-debug-name b1) is now ,new-count)) (newline)
(define new-flows (if (zero? new-count)
(begin (enqueue-message! b1 (departed flow why))
(hash-remove old-flows flow))