bind pasted by andyjpb on Wed Apr 9 15:21:24 2014

(define assert-mailbox-1 assert-addr-spec)

(define mailbox-1 (bind
		    addr-spec

		    (lambda (r)
		      (assert-mailbox-1 r)

		      (let ((e (new-email-address)))

			(set-addr-spec e r)

			(result e)))))

; phrase route-addr
; Result: '(phrase route-addr)
(define (assert-mailbox-2 x)
  (assert (list? x))
  (assert (= 2 (length x))))

(define mailbox-2 (bind
		    (sequence* ((phrase phrase)
				(_ (zero-or-more linear-white-space))
				(route-addr route-addr))

			       (result (list phrase route-addr)))

		    (lambda (r)
		      (assert-mailbox-2 r)

		      (let ((e          (new-email-address))
			    (phrase     (first r))
			    (route-addr (second r)))
			(assert-phrase     phrase)
			(assert-route-addr route-addr)

			(set e 'name phrase)

			(let ((route     (first route-addr))
			      (addr-spec (second route-addr)))
			  (assert-route     route)
			  (assert-addr-spec addr-spec)

			  (set e 'route route)
			  (set-addr-spec e addr-spec))

			(result e)))))

simplified mailbox-2 pasted by DerGuteMoritz on Wed Apr 9 15:25:05 2014

(define mailbox-2
  (sequence* ((phrase phrase)
              (_ (zero-or-more linear-white-space))
              (route-addr route-addr))
    (assert-mailbox-2 r)
    (let ((e          (new-email-address))
          (phrase     (first r))
          (route-addr (second r)))
      (assert-phrase     phrase)
      (assert-route-addr route-addr)

      (set e 'name phrase)

      (let ((route     (first route-addr))
            (addr-spec (second route-addr)))
        (assert-route     route)
        (assert-addr-spec addr-spec)

        (set e 'route route)
        (set-addr-spec e addr-spec))

      (result e))))

suggestion for separation added by DerGuteMoritz on Wed Apr 9 15:27:48 2014

(define (make-mailbox phrase route-addr)
  (let ((e (new-email-address)))
    (assert-phrase     phrase)
    (assert-route-addr route-addr)

    (set e 'name phrase)

    (let ((route     (first route-addr))
          (addr-spec (second route-addr)))
      (assert-route     route)
      (assert-addr-spec addr-spec)

      (set e 'route route)
      (set-addr-spec e addr-spec))

    e))

(define mailbox-2
  (sequence* ((phrase phrase)
              (_ (zero-or-more linear-white-space))
              (route-addr route-addr))
    (result (make-mailbox phrase route-addr))))