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
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))