0

运行以下代码时,我在结果中的某些地方不断重复#<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)))))

; 组合每个为 true 的元素;对于给定的谓词

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

; 获取两个 (list1) 和另一个的列表;任何长度的列表(list2)并返回;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))
4

1 回答 1

0

该问题将受益于有关如何使用代码的一些信息,以及对处理人员对象消息的函数的目的和用法的一些评论。

但是,问题似乎是#<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)))  
于 2013-03-20T21:11:33.097 回答