麻省理工学院计划消息传递抽象邮件程序

时间:2013-05-07 21:13:17

标签: list scheme repeat abstraction message-passing

我之前在这里询问了有关消息传递抽象的问题: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.)

作为此作业的一部分,我之前已经编写过2个程序来制作邮箱并写一封信:

(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))

基本上,我现在遇到一个不同的错误,而是返回将distribute-the-letters过程作为参数传递给length,而不是列表。我不知道为什么要返回这个错误,因为我认为我在需要时传递列表。是否有人能够了解正在发生的事情?任何帮助将不胜感激。

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

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

1 个答案:

答案 0 :(得分: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”对象还必须具有“地址”(我们通过调用(letter 'get-address)检索,对于我们称为(mbox 'get-address)的邮箱),这些地址必须是这样我们才能比较它们平等。

这意味着字母和邮箱应该是通过与定义邮件员的过程相同的过程定义的对象,具有内部过程,以及作为对象本身导出的调度过程。

这一切都需要进一步实施,或者你可能已经将它们作为之前任务的一部分了吗?


现在您已经提供了其他定义,让我们看看。

make-letter似乎没问题。一封信支持两条消息:'get-destinationget-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中,任何非假值都类似于#t

您的previous-post(如果已修复w /(12))返回其参数列表的最后一个cdr单元格。如果它包含字母(a b c d),则(previous-post T)会返回(d)。你的意思不是a吗?它处理的消息毕竟被称为'get-latest-message。无论您刚刚将cons添加到列表ls中,都可以通过一个简单的调用来回复...(什么?)。

为什么叫get-latest-message?它是否会返回一封信或该信中的信息? (这里的消息一词在一个程序中用于两种完全无关的意义;更好的呼号字母的内容,也许是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 .... ))))