fixup

1 files changed, 62 insertions, 0 deletions

diff --git a/coding-exercises/2/74.rkt b/coding-exercises/2/74.rkt
new file mode 100644
index 0000000..c6bc137
--- /dev/null
+++ b/coding-exercises/2/74.rkt
@@ -0,0 +1,62 @@
+#lang racket
+(require "../../shared/data-directed-programming.rkt")
+(require "../../shared/lists.rkt")
+
+(define test-dispatch (make-dispatch-table))
+(define get (getter test-dispatch))
+(define put (putter test-dispatch))
+
+;; Example implementations
+(define test-division (attach-tag 
+                          'division-a
+                          (list (attach-tag 
+                                  'henk 
+                                  (list (attach-tag 'salary 100))))))
+(put 'record 'division-a (lambda (file-set employee) 
+                           (let ((record (find-first 
+                                           (make-eq-type? employee) 
+                                           file-set)))
+                             (if record
+                               record
+                               (error "Employee record not found -- GET-RECORD DIVISION-A" employee)))))
+(put 'salary 'division-a (lambda (record)
+                           (let ((salary (find-first
+                                           (make-eq-type? 'salary)
+                                           record)))
+                             (if salary
+                               salary
+                               (error "Salary not found -- GET-SALARY DIVISION-A" record)))))
+
+;;a Each divisions file must be a datum tagged with the divisions name.
+;;  Together with the division type tag and an operation type tag
+;;  we can get a procedure that knows how to do that operation for the given employee.
+(define (get-record file employee)
+  ((get 'record (type-tag file)) (contents file) employee))
+
+(define test-record (get-record test-division 'henk))
+
+;; b The record can have any structure that is handled by the salary procedure of the
+;; division we dispatch the procedure from
+(define (get-salary file record)
+  ((get 'salary (type-tag file)) (contents record)))
+
+
+(get-salary test-division test-record)
+
+;;c
+(define (find-employee-record files employee)
+   (define (search fi)
+     (if (null? fi)
+       false
+       (let ((result (with-handlers
+                       ([exn:fail? (lambda (exn)
+                                     false)])
+                       (get-record (car fi) employee))))
+         (if result
+           result
+           (search (cdr fi))))))
+   (search files))
+(find-employee-record (list test-division test-division) 'henk)
+
+;;d
+;; new implementations for the division representation for the existing operations on a type