(define tagged-datum 
  (lambda (type value)
    (cons type value)))

(define type car)

(define contents cdr)

(define make-type 
  (lambda (name operation-table)
    (cons name operation-table)))

(define type-name car)

(define type-operation-table cdr)

(define operate
  (lambda (operation-name value)
    (table-find (type-operation-table (type value))
                operation-name
                (lambda (procedure) ; use this if found
                  (procedure (contents value)))
                (lambda ()          ; use this if not found
                  (error "No way of doing operation on type" 
                         operation-name
                         (type-name (type value)))))))

(define make-table
  (lambda (keys values)
    (cons keys values)))

(define table-find
  (lambda (table key what-if-found what-if-not) 
    (define loop
      (lambda (keys values)
        (cond ((null? keys) (what-if-not))
              ((equal? key (car keys))
               (what-if-found (car values)))
              (else
               (loop (cdr keys) (cdr values))))))
    (loop (car table) (cdr table))))

(define num
  (make-type 'num
             (make-table '(double triple square)
                         (list (lambda (x)
                                 (* 2 x))
                               (lambda (x)
                                 (* 3 x))
                               (lambda (x)
                                 (* x x))))))


(define lst
  (make-type 'lst
             (make-table '(double triple)
                         (list (lambda (x)
                                 (append x x))
                               (lambda (x)
                                 (append x
                                         (append x 
                                                 x)))))))

(define double
  (lambda (x)
    (operate 'double x)))

(define square
  (lambda (x)
    (operate 'square x)))

(define triple
  (lambda (x)
    (operate 'triple x)))

(define n3 (tagged-datum num 3))
(define lab (tagged-datum lst '(a b)))