MIT方案消息传递抽象Mailman过程

Question

我之前在这里问了一个关于消息传递抽象的问题：MIT Scheme Message Passing Abstraction

这个问题是这样问的：

Write a mailman object factory (make-mailman) that takes in no parameters and returns 
a message-passing object that responds to the following messages:

'add-to-route: return a procedure that takes in an arbitrary number of mailbox objects 
 and adds them to the mailman object's “route”
'collect-letters: return a procedure that takes in an arbitrary number of letter 
 objects and collects them for future distribution
'distribute: add each of the collected letters to the mailbox on the mailman's route 
 whose address matches the letter's destination and return a list of any letters whose 
 destinations did not match any mailboxes on the route (Note: After each passing of 
 'distribute the mailman object should have no collected letters.)

作为这个任务的一部分，我之前已经写了两个过程来制作一个邮箱和一封信：

(define (make-letter destination message)
  (define (dispatch x)
    (cond ((eq? x 'get-destination) destination)
          ((eq? x 'get-message) message)
          (else "Invalid option.")))
      dispatch)

(define (make-mailbox address)
  (let ((T '()))
    (define (post letter)
      (assoc letter T))
    (define (previous-post post)
      (if (null? (cdr post)) post (cdr (previous-post post))))
    (define (letter-in-mailbox? letter)
      (if (member (post letter) T) #t #f))
    (define (add-post letter)
      (begin (set! T (cons letter T)) 'done))
    (define (get-previous-post post)
      (if (letter-in-mailbox? post)
          (previous-post post)
          #f))
    (define (dispatch y)
      (cond ((eq? y 'add-letter) add-post)
            ((eq? y 'get-latest-message) (get-previous-post T))
            ((eq? y 'get-address) address)
            (else "Invalid option.")))
        dispatch))

在得到了一个很好的解释，说明了我现在的答案做错了什么，并对我的代码进行了许多必要的修改后，我被告知，我在代码中遇到的任何问题都不如在这个问题中提出。因此，以下是根据我之前的问题构建的代码：

(define (make-mailman)
  (let ((self (list '(ROUTE) '(MAILBAG))))
    (define (add-to-route . mailboxes)
      (let ((route (assoc 'ROUTE self)))
        (set-cdr! route (append mailboxes (cdr route))) 
        'DONE))
    (define (collect-letters . letters)
      (let ((mailbag (assoc 'MAILBAG self)))
        (set-cdr! mailbag (append letters (cdr mailbag)))
        'DONE))
    (define (distribute-the-letters)
      (let* ((mailbag (assoc 'MAILBAG self))
             (mailboxes (cdr (assoc 'ROUTE self)))
             (letters (cdr mailbag)))
        (if (null? letters)
            ()
            (let loop ((letter (car letters))
                       (letters (cdr letters))
                       (not-delivered ()))
              (let* ((address (letter 'get-address))
                     (mbx (find-mailbox address mailboxes)))
                (if (equal? address letter)
                    ((mbx 'add-post) letter)
                    ((mbx 'add-post) not-delivered))
                (if (null? letters)
                    (begin (set-cdr! mailbag '()) not-delivered)
                    (loop (car letters) (cdr letters) not-delivered)))))))
    (define (dispatch z)
      (cond ((eq? z 'add-to-route) add-to-route)
            ((eq? z 'collect-letters) collect-letters)
            ((eq? z 'distribute) distribute-the-letters)
            (else "Invalid option")))
    dispatch))

从本质上讲，我现在遇到了一个不同的错误，它返回分发字母过程作为参数传递给length，而不是list。我不知道为什么会返回这个错误，因为我会认为我是在传递需要的列表。有没有人能解释清楚到底发生了什么？任何帮助都将不胜感激。

更新:现在在我的make-mailman代码中使用这个过程：

(define (find-mailbox address mailbox)
  (if (not (element? address self))
      #f
      (if (element? mailbox self)
          mailbox
          #f)))

Answer 1

你的错误在这里：

(define (distribute-the-letters)
  (let* ((mailbag (assoc 'MAILBAG self))
         (mailboxes (cdr (assoc 'ROUTE self)))
         (letters (cdr mailbag)))
    (if (null? letters)
      ()
      (let loop ((letter (car letters))
                 (letters (cdr letters))
                 (not-delivered ()))
        (let* ((address (letter 'get-address))
               (mbx (find-mailbox address mailboxes)))  ;; has to be impl'd

      ;;  (if (equal? address letter)          ;; this makes
      ;;    ((mbx 'add-post) letter)           ;;  no
      ;;    ((mbx 'add-post) not-delivered))   ;;   sense   

          ;; here you're supposed to put the letter into the matching mailbox
          ;; or else - into the not-delivered list
          (if mbox                  ;; NB! find-mailbox should accommodate this
            ((mbox 'put-letter) letter)   ;; NB! "mailbox" should accom'te this
            (set! not-delivered      ;; else, it wasn't delivered
              (cons letter not-delivered)))

          (if (null? letters)
            (begin 
              (set-cdr! mailbag '())       ;; the mailbag is now empty
              not-delivered)                       ;; the final return
            (loop (car letters) 
                  (cdr letters) 
                  not-delivered)))))))

find-mailbox仍然需要在这里实现。它应该搜索匹配的邮箱，如果没有找到，则返回#f；如果找到，则返回邮箱对象本身。“邮箱”对象必须能够响应'put-letter消息，并且具有“地址”。"letter“对象还必须有" addresses”(我们使用调用(letter 'get-address)来检索它，对于邮箱，我们调用(mbox 'get-address))，并且这些地址必须是，以便我们可以比较它们是否相等。

这意味着信件和邮箱应该是通过与这里定义邮递员相同的过程定义的对象，具有内部过程，并且调度过程作为对象本身导出。

这一切都需要进一步实现，或者您已经将它们作为以前任务的一部分？

既然您已经提供了额外的定义，让我们来看看。

make-letter看起来还不错。一封信支持两条消息：'get-destination和get-message。

make-mailbox有问题。

(define (make-mailbox address)
  (let ((T '()))
    (define (post letter)
      (assoc letter T))         ;; why assoc? you add it with plane CONS
    (define (previous-post post)
      (if (null? (cdr post))         ;; post == T (11)
          post 
          (cdr (previous-post post)  ;; did you mean (prev-p (cdr post)) ? (12)
          )))
    (define (letter-in-mailbox? letter)        ;; letter == T ???????  (3)
      (if (member (post letter) T) #t #f))
    (define (add-post letter)
      (begin (set! T (cons letter T)) 'done))  ;; added with plane CONS
    (define (get-previous-post post)
      (if (letter-in-mailbox? post)            ;; post == T            (2)
          (previous-post post)        ;; post == T (10)
          #f))
    (define (dispatch y)
      (cond ((eq? y 'add-letter) add-post)
            ((eq? y 'get-latest-message) 
               (get-previous-post T))          ;; called w/ T          (1)
            ((eq? y 'get-address) address)
            (else "Invalid option.")))
        dispatch))

你用add-post添加字母，它就会调用(set! T (cons letter T))。因此，它将每个字母按原样添加到T列表中。以后不需要使用assoc来检索它，它只是一个列表中的一个元素。只要给(member letter T)打电话看看它是否在里面就行了。post没有要执行的函数，它应该是(define (post letter) letter)。

(if (member letter T) #t #f)在功能上与(member letter T)相同。在Scheme中，任何非False值都类似于#t。

您的previous-post (如果修复为w/ (12) )返回其参数列表的最后一个cdr单元格。如果包含字母(a b c d)，则(previous-post T)返回(d)。你不是想让它成为a吗？它处理的消息毕竟被称为'get-latest-message。您刚才使用cons添加到列表ls中的任何内容，都可以通过一个简单的调用来取回...(什么？)

为什么它被称为get-latest-message？它是返回一个字母，还是返回该字母中的消息？(在这里，message这个词在一个程序中有两种完全不相关的含义；最好把letter的内容称为letter-contents？)

最后，我们在主程序中调用(find-mailbox address mailboxes)，但您要定义(define (find-mailbox address mailbox) ...。它应该与(equal? address (mailbox 'get-address))进行比较。不需要self，所以这个实用函数可以放入全局作用域。并且它必须通过这些mailboxes枚举

(define (find-mailbox address mailboxes)
  (if (not (null? mailboxes))
    (if (equal? address ((car mailboxes) 'get-address))
      (car ..... )
      (find-mailbox address .... ))))