;; load library with error in it
(require (lib "23.ss" "srfi"))

;; DATA DIRECTED PROGRAMMING

; operation-table will hold the triples of
; operations, their type, and the associated action
(define operation-table ())

; takes an operation, the type of data it acts
; on, and an action that implements the operation
; on the type given.  Adds the triple to the 
; operation table
(define (put operation type action)
  (set! operation-table
        (cons (list operation type action)
              operation-table)))

; takes an operator and a type, and returns the action
; that implements the operator for that type in the
; operation-table
(define (get operator type)
  (define (get-aux list)
    (cond ((null? list) #f)
          ((and (equal? operator (caar list))
                (equal? type (cadar list)))
           (caddar list))
          (else (get-aux (cdr list)))))
  (get-aux operation-table))

;;; general operation will implement selector
;; functions for complex numbers
(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
            "APPLY-GENERIC failed"
            (list op type-tags))))))



;;;;;;;; Operations for tagged data ;;;;;;;;;
; takes a tag and some contents and creates a
; tagged data element (consisting of the tag
; and the data contents
(define (attach-tag type-tag contents)
  (cons type-tag contents))

; takes a data item and returns the tag 
; associated with the data item.  Assume
; the data item is tagged as long as it
; is a pair.
(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error "TYPE-TAG finds bad datum"
             datum)))

; takes a data item and returns the content part
; of that data item.  Assume the data item is 
; tagged as long as it is a pair.
(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      (error "CONTENTS finds bad datum"
             datum)))