I previously asked a question concerning message passing Abstraction here: MIT Scheme Message Passing Abstraction
The question asked that I:
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.)
I had already written 2 procedures earlier as part of this assignment to make a mailbox and make a letter:
(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))
After being given a very good explanation on what my current answer was doing wrong and making many necessary changes to my code, I was told that any problems I have in that code would be better off asked in this question. Therefore, here is the code that builds off my previous question:
(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))
Essentially, I'm running into a different error now that instead returns that the distribute-the-letters procedure is being passed as an argument to length, which is not a list. I do not know why this error is being returned, since I would think that I am passing in the lists as they are needed. Would anyone be able to shed some light on what's going on? Any help will be appreciated.
UPDATE: Using this procedure in my make-mailman code now:
(define (find-mailbox address mailbox)
(if (not (element? address self))
#f
(if (element? mailbox self)
mailbox
#f)))
Your error is here:
(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 still has to be implemented here. It should search for the matching mailbox, and return #f in case it is not found, or return the mailbox object itself if it was found. The "mailbox" objects must be able to respond to 'put-letter messages and have "addresses". The "letter" objects must also have "addresses" (which we retrieve with the call (letter 'get-address), and for mailbox we'd call (mbox 'get-address)), and these addresses must be so that we can compare them for equality.
That means that letters and mailboxes should be objects defined through the same kind of procedure as here the mailman is defined, with internal procedures, and the dispatch procedure exported as the object itself.
This all needs to be further implemented, or perhaps you have them already as part of some previous assignment?
now that you've provided your additional definitions, let's see.
make-letter seems OK. A letter supports two messages: 'get-destination and get-message.
make-mailbox has issues.
(define (make-mailbox address)
(let ((T '()))
(define (post letter)
(assoc letter T)) ;; why assoc? you add it with plain 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 plain 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))
you add letters with add-post, and it calls (set! T (cons letter T)). So it adds each letter into the T list as-is. No need to use assoc to retrieve it later, it's just an element in a list. Just call (member letter T) to find out whether it's in. post has no function to perform, it should be (define (post letter) letter).
(if (member letter T) #t #f) is functionally the same as just (member letter T). In Scheme, any non-false value is like a #t.
Your previous-post (if fixed w/ (12) ) returns the last cdr cell of its argument list. If it holds letters (a b c d), (previous-post T) returns (d). Didn't you mean it to be a ? The message it handles is called 'get-latest-message after all. Whatever you just added with cons into list ls, can be gotten back with one simple call to ... (what?).
And why is it called get-latest-message? Does it return a letter, or the message within that letter? (and here the word message is used in two completely unrelated senses in one program; better call letter's contents, maybe, letter-contents ??
Lastly, we call (find-mailbox address mailboxes) in the main program, but you define (define (find-mailbox address mailbox) .... It should compare (equal? address (mailbox 'get-address)). self isn't needed, so this utility function can be put into global scope.
And it must enumerate through those mailboxes:
(define (find-mailbox address mailboxes)
(if (not (null? mailboxes))
(if (equal? address ((car mailboxes) 'get-address))
(car ..... )
(find-mailbox address .... ))))