;; Multicast-Channels / Exchanges mit verallgemeinerten Streams

(define-record-type :exchange
  (really-make-exchange request-channel port-channel)
  exchange?
  (request-channel exchange-request-channel)
  (port-channel exchange-port-channel))

(define-record-type :port
  (make-port channel)
  port?
  (channel port-channel))

(define-record-type :send-request
  (make-send-request message)
  send-request?
  (message send-request-message))

(define-record-type :new-port-request
  (make-new-port-request)
  new-port-request?)

(define-record-type :exchange-state
  (make-exchange-state first placeholder)
  exchange-state?
  (first exchange-state-first)
  (placeholder exchange-state-placeholder))

(define the-new-port-request (make-new-port-request))

(define (make-exchange)
  (let ((request-channel (make-channel))
	(port-channel (make-channel)))
    (let ((make-port
	   (lambda (placeholder)
	     (let ((out-channel (make-channel)))
	       (spawn
		(lambda ()
		  (let tee ((placeholder placeholder))
		    (let* ((state (placeholder-value placeholder))
			   (first (exchange-state-first state))
			   (placeholder 
			    (exchange-state-placeholder state)))
		      (send out-channel first)
		      (tee placeholder)))))
	       (make-port out-channel)))))
      (spawn
       (lambda ()
	 (let server ((placeholder (make-placeholder)))
	   (let ((request (receive request-channel)))
	     (cond
	      ((new-port-request? request)
	       (send port-channel (make-port placeholder))
	       (server placeholder))
	      ((send-request? request)
	       (let ((next-placeholder (make-placeholder)))
		 (placeholder-set! placeholder
				   (make-exchange-state
				    (send-request-message request)
				    next-placeholder))
		 (server next-placeholder))))))))
      (really-make-exchange request-channel port-channel))))

(define (exchange-send exchange message)
  (send (exchange-request-channel exchange)
	(make-send-request message)))

(define (make-exchange-port exchange)
  (send (exchange-request-channel exchange) the-new-port-request)
  (receive (exchange-port-channel exchange)))

(define (port-receive-rv port)
  (receive-rv (port-channel port)))