Structure And Interpretation of Computer Programs Ex2_74

Question

I'm trying to tag a list so that the file1 variable out like the following in Racket:

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

however I am getting:

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

I am using "tag" internally in my package to tag a series of records using the make-file procedure. It should follow the evaluation model set out in section 1.1.3 I think, but it feels like it isn't and this may be to do with the fact that I have defined make-file to take an arbitrary number of arguments which may effect the evaluation model in ways I haven't yet understood. I've also attempted to debug this in Racket to no avail as it skips how it is evaluated as I step through, so I'm stuck. If anyone could help, it would be greatly appreciated.

#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)
 (put 'make-file 'Div1 
      (lambda args 
        (tag (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

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

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

file1

Answer 1

You forgot to actually call the make-file procedure:

(define (make-file . records) 
  (get 'make-file 'Div1) ; retrieves the procedure, does nothing with it
  records)               ; return the same input list

Also, because you want to take an arbitrary number of arguments you need to apply it; this should work:

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