計劃匹配器中的錯誤

Question

在運行下面的代碼時，我在結果中的某些地方不斷得到#<procedure:me>的重複，並且我找不到原因。

要測試：運行(match-make men women)

下面是代碼：

;;爲球拍

(define (write-line x) 
    (display x) 
    (newline)) 

(define (append! a b) 
    (if (null? (cdr a)) 
     (set-cdr! a b) 
     (append! (cdr a) b))) 

兼容性;這開始了比賽制作計劃，並在 ;最初的提議者和建議者，重置他們的狀態和 ;將他們送到求偶程序 ;建議將開始

(define (match-make proposers proposees) 
    (send proposers 'reset) 
    (send proposees 'reset) 
    (courtship proposers proposers) 
    (zip-together (send proposers 'name) 
      (send (send proposers 'intended) 'name))) 

;每個沒有參加計劃的提議者建議，直到沒有 ;更多未提及的提議者

(define (courtship unengaged-proposers proposers) 
    (if (null? unengaged-proposers) 
     (display "match-make complete") 
     (begin ((car unengaged-proposers) 'propose) 
      (courtship (currently-unengaged unengaged-proposers) proposers)))) 

;獲得目前不接受的人

(define (currently-unengaged list-of-people) 
    (filter unengaged list-of-people)) 

;檢查一個人是否沒有參與

(define (unengaged person) 
    (if (null? (person 'intended)) 
     #t 
     #f)) 

;將給定的消息發送給每個人 ;在給定的人列表中

(define (send list-of-people message) 
    (if (null? list-of-people) 
     '() 
     (begin ((car list-of-people) message) 
     (send (cdr list-of-people) message)))) 

;檢查兩個給定的人 ;是一對夫婦

(define (couple? person1 person2) 
    (if ((eq? (person1 'intended) person2) #t) 
     #t 
     #f)) 

;結合兩個給定的列表

(define (zip-together list1 list2) 
    (if (null? list1) 
     '() 
     (cons (list (car list1) (car list2)) 
      (zip-together (cdr list1) (cdr list2))))) 

;組合每個真正的元素 ;對於給定的謂詞

(define (filter pred lst) 
    (cond ((null? lst) '()) 
     ((pred (car lst)) (cons (car lst) (filter pred (cdr lst)))) 
     (else (filter pred (cdr lst))))) 

;列出兩個（list1）和另一個 ;任何長度的列表（列表2）並返回 ;無論哪一個在list1中出現第一個 ;在列表2中

(define (preference list1 list2) 
    (write (list list1 list2)) 
    (cond ((eq? (car list1) (car list2)) (car list1)) 
     ((eq? (cadr list1) (car list2)) (cadr list1)) 
     (else (preference list1 (cdr list2))))) 

;創建一個具有特定狀態的人 ;以及可以稱爲 的某些消息;在那個人身上。我在哪裏標註了 ;爲問題1添加，問題2爲 ;任何地方它說顯示器和換行符

(define (make-person my-name) 
    (let ((preference-list '()) 
     (possible-mates '()) 
     (current-intended '())) 
    (define (i-like-more person1 person2) ;Problem 1 
     (preference (list person1 person2) preference-list) 
     (cond ((eq? (car (me 'loves)) person1) #t) 
      ((eq? (car (me 'loves)) person2) #f) 
      (else (preference (list person1 person2) (cdr preference-list))))) 
    (define (me message) 
     (cond ((eq? message 'name) my-name) 
      ((eq? message 'intended) current-intended) 
      ((eq? message 'loves) preference-list) 
      ((eq? message 'possible) possible-mates) 
      ((eq? message 'reset) 
       (set! current-intended '()) 
       (set! possible-mates preference-list) 
       'reset-done) 
      ((eq? message 'load-preferences) 
       (lambda (plist) 
       (set! preference-list plist) 
       (set! possible-mates plist) 
       (set! current-intended '()) 
       'preferences-loaded)) 
      ((eq? message 'propose) 
      (let ((beloved (car possible-mates))) 
       (begin 
       (set! possible-mates (cdr possible-mates)) 
       (begin 
        (display (me 'name)) 
        (display " proposed to ") 
        (display (beloved 'name)) 
        (newline)) 
       (if (eq? ((beloved 'i-love-you) me) 
          'i-love-you-too) 
         (begin 
         (display (me 'name)) 
         (display " and ") 
         (display (beloved 'name)) 
         (display " are engaged ") 
         (newline) 
         (set! current-intended beloved) 
         'we-are-engaged) 
        (begin 
         (display "no one loves me") 
         'no-one-loves-me))))) 
      ((eq? message 'i-love-you) ;Problem 1 
       (lambda (proposer) 
       (cond 
        ((null? (me 'intended)) 
        (begin 
        (set! current-intended proposer) 
        (display (me 'intended)) 
        (display " says i love you too") 
        (newline) 
        'i-love-you-too)) 
        ((i-like-more proposer (me 'intended)) 
        (begin 
         (set! current-intended proposer) 
         (display (me 'intended)) 
         (display " dumped ") 
         (display (me 'intended)) 
         (newline) 
        (((me 'intended) 'i-changed-my-mind) me) 
        'i-love-you-too)) 
       (else (begin 
       (display (me 'intended)) 
       (display " rejected ") 
       (display (me 'name)) 
       'buzz-off-creep))))) 
     ((eq? message 'i-changed-my-mind) 
      (lambda (lost-love) 
      (cond ((eq? current-intended lost-love) 
        (set! current-intended '()) 
        'dumped!) 
        (else 
        'there-must-be-some-misunderstanding)))) 
     (else 
      (display "Bad message to a person") 
      (newline) 
      (list my-name message)))) 
    me)) 

;;這是一個測試文件

(define alan (make-person 'Alan)) 
(define bob (make-person 'Bob)) 
(define charles (make-person 'Chuck)) 
(define david (make-person 'Dave)) 
(define ernest (make-person 'Ernie)) 
(define franklin (make-person 'Frank)) 
(define agnes (make-person 'Agnes)) 
(define bertha (make-person 'Bertha)) 
(define carol (make-person 'Carol)) 
(define deborah (make-person 'Debbie)) 
(define ellen (make-person 'Ellen)) 
(define francine (make-person 'Fran)) 

((alan 'load-preferences) 
    (list agnes carol francine bertha deborah ellen)) 
((bob 'load-preferences) 
    (list carol francine bertha deborah agnes ellen)) 
((charles 'load-preferences) 
(list agnes francine carol deborah bertha ellen)) 
((david 'load-preferences) 
    (list francine ellen deborah agnes carol bertha)) 
((ernest 'load-preferences) 
    (list ellen carol francine agnes deborah bertha)) 
((franklin 'load-preferences) 
    (list ellen carol francine bertha agnes deborah)) 
((agnes 'load-preferences) 
(list charles alan bob david ernest franklin)) 
((bertha 'load-preferences) 
(list charles alan bob david ernest franklin)) 
((carol 'load-preferences) 
(list franklin charles bob alan ernest david)) 
((deborah 'load-preferences) 
    (list bob alan charles franklin david ernest)) 
((ellen 'load-preferences) 
(list franklin charles bob alan ernest david)) 
((francine 'load-preferences) 
(list alan bob charles david franklin ernest)) 

(define men (list alan bob charles david ernest franklin)) 
(define women (list agnes bertha carol deborah ellen francine)) 

Answer 1

的問題，將有助於對代碼是如何打算的一些信息中獲益使用，並且還對處理消息的人對象的功能用途和使用情況的意見。

但是，該問題似乎顯示#<procedure:me>，而不是運行該程序時的某些預期字符串。

顯示的是返回而不是被調用的函數。有幾個方面的原因：

1. 功能preference被定義爲是人的對象列表write第一個參數。
2. 在處理消息的代碼中，使用(write (me 'intended))，其中(write (me 'name)或(write ((me 'intended) 'name)應該已被使用。

另外：i-like-more，要求preference應該被定義爲

(define (i-like-more person1 person2)      
    (eq? person1 (preference (list person1 person2) preference-list)))