《计算机程序的构造和解释》习题2.74 Racket make-file标签缺失问题求助

你遇到的问题由两处代码错误共同导致：

• 第一处：顶层make-file过程完全没有调用注册到泛型表中的打标签逻辑，直接返回了输入参数
  你原写法是：

  (define (make-file . records) 
    (get 'make-file 'Div1) records)
  

  这段代码只会执行get操作拿到过程但不调用，最后直接返回参数列表records，所以完全没有打标签的步骤，自然输出不带Div1标签。
• 第二处：Div1包内注册的make-file过程存在参数重复打包问题，会导致最终内容多套一层括号
  你包内注册的过程是：

  (lambda args 
    (tag (make-file args)))
  

  这里lambda args已经把所有传入参数打包成了args列表，而内部定义的make-file是可变参数形式，会把传入的args再打包一次，最终内容会变成((record1 record2 ...))多一层嵌套。

完整修正代码 #

#lang sicp

(#%require (only racket/base error))
(#%require (only racket/base make-hash))
(#%require (only racket/base hash-set!))
(#%require (only racket/base hash-ref))

; table set up

(define *op-table* (make-hash))

(define (put op type proc)
  (hash-set! *op-table* (list op type) proc))

(define (get op type)
  (hash-ref *op-table* (list op type) '()))

; data tagging set up

(define (attach-tag type-tag contents) 
  (cons type-tag contents))

(define (type-tag datum) 
  (if (pair? datum) 
      (car datum) 
      (error "Bad tagged datum -- TYPE-TAG" datum)))

(define (contents datum) 
  (if (pair? datum) 
    (cdr datum) 
    (error "Bad tagged datum -- CONTENTS" datum)))

(define (apply-generic op . args) 
  (let ((type-tags (map type-tag args))) 
    (let ((proc (get op type-tags))) 
      (if proc 
          (apply proc (map contents args)) 
          (error 
            "No method for these types -- APPLY-GENERERIC" 
            (list op type-tags))))))

(define (install-Div1-Package) 
  (define (get-name record) 
  (car record))
  (define (get-address record) 
    (cadr record))
  (define (get-salary record) 
    (caddr record))
  (define (make-record name address salary) 
    (list name address salary))
  (define (get-record key file) 
    (cond ((null? file) (error "Employee not in file")) 
          ((eq? key (get-name (car file))) 
           (car file)) 
          (else (get-record key (cdr file)))))
  (define (make-file . records) 
    records)
  ;interface to the rest of the system
 (define (tag x) (attach-tag 'Div1 x)) 
 (put 'get-name '(Div1) get-name)
 (put 'get-address '(Div1) get-address)
 (put 'get-salary '(Div1) get-salary)
 (put 'make-record 'Div1 
      (lambda (name address salary) 
        (make-record name address salary)))
 (put 'get-record '(Div1) get-record)
 ; 修复参数重复打包问题：用apply展开args传入内部make-file
 (put 'make-file 'Div1 
      (lambda args 
        (tag (apply make-file args)))))

(install-Div1-Package)

(define (make-record name address salary) 
  ((get 'make-record 'Div1) name address salary))

(define record1 (make-record 'Sam 'Parnell 100))
(define record2 (make-record 'Tom 'Edward 1000))
(define record3 (make-record 'Rob 'Hanbury 500))
(define record4 (make-record 'Andy 'Springwood 500))

record1

; 修复未调用泛型过程问题：执行get拿到的make-file过程，用apply展开参数列表传入
(define (make-file . records) 
  (apply (get 'make-file 'Div1) records))

(define file1 (make-file record1 record2 record3 record4))

file1

运行结果 #

修正后file1的输出完全符合预期：

(Div1 ((Sam Parnell 100) (Tom Edward 1000) (Rob Hanbury 500) (Andy Springwood 500)))

内容的提问来源于stack exchange，提问作者Samuel Palmer