;; Caltech CS 1 Fall 2007
;; Scheme code for lecture 12 (11/07/2007)
;; mvanier@cs.caltech.edu
;; Page 1 of 3

;; A message-passing meter implementation
(define (make-meter x)
  (lambda (op . args)
    (cond 
      ((eq? op 'get-length) x)
      ((eq? op 'get-type) 'meter)
      ((eq? op 'add)
       (make-meter 
        (+ x ((car args) 'get-length))))
      (else (error "unknown op" op)))))

;; Usage:

(define foo (make-meter 5))
(define bar (make-meter 3))
(foo 'get-length) ; => 3
(foo 'get-type)   ; => meter
(define baz (foo 'add bar))
(baz 'get-length) ; => 8

;; Adding a foot implementation
;; and include code to deal with addition:

(define (make-meter x)
  (lambda (op . args)
    (cond 
      ((eq? op 'get-length) x)
      ((eq? op 'get-type) 'meter)
      ((eq? op 'add)
       (let ((other (car args)))
         (cond
           ((eq? (other 'get-type) 'meter)
            (make-meter (+ x (other 'get-length))))
           ((eq? (other 'get-type) 'foot)
            (make-meter (+ x (* (other 'get-length) 0.3048))))
           (else (error "unknown type" (other 'get-type))))))
      (else (error "unknown op" op)))))

(define (make-foot x)
  (lambda (op . args)
    (cond 
      ((eq? op 'get-length) x)
      ((eq? op 'get-type) 'foot)
      ((eq? op 'add)
       (let ((other (car args)))
         (cond
           ((eq? (other 'get-type) 'foot)
            (make-foot (+ x (other 'get-foot))))
           ((eq? (other 'get-type) 'meter)
            (make-foot (+ x (/ (other 'get-length) 0.3048))))
           (else (error "unknown type" (other 'get-type))))))
      (else (error "unknown op" op)))))


;; Page 2 of 3

;; Usage:

(define foo (make-meter 1))
(define bar (make-foot 1))
(define baz (foo 'add bar))

;; Auto-coercing versions for addition:

(define (make-meter x)
  (lambda (op . args)
    (cond 
      ((eq? op 'get-length) x)
      ((eq? op 'get-type) 'meter)
      ((eq? op 'convert-to-base) (make-meter x))
      ((eq? op 'add)
       (let ((other (car args)))
         (make-meter 
          (+ x ((other 'convert-to-base) 'get-length)))))
      (else (error "unknown op" op)))))

(define (make-foot x)
  (define as-meter (* x .3048))
  (lambda (op . args)
    (cond 
      ((eq? op 'get-length) x)
      ((eq? op 'get-type) 'foot)
      ((eq? op 'convert-to-base) 
       (make-meter as-meter))
      ((eq? op 'add)
       (let ((other (car args)))
         (make-meter 
          (+ as-meter 
             ((other 'convert-to-base) 'get-length)))))
      (else (error "unknown op" op)))))


;; Page 3 of 3

;; Set interface:
;;
;; add-element (add an element to a set)
;; remove-element (remove an element from a set)
;; contains? (does a set contain a particular element?)
;; union (create the union of two sets)
;; intersection (create the intersection of two sets)
;;

;; Skeleton of list-based set implementation:
(define (make-simple-set items)
  (lambda (op . args)
    (cond ((eq? op 'add-element) (...))
          ((eq? op 'remove-element) (...))
          ((eq? op 'contains?) (...))
          ((eq? op 'union) (...))
          ((eq? op 'intersection) (...))
          (else (error "unknown op: " op)))))

;; Usage:
(define a-set (make-simple-set (list)))
(define a-set (a-set 'add-element 1)) ; redefine a-set
(define a-set (a-set 'add-element 2)) ; redefine a-set again
(a-set 'contains? 3) ; => #f

;; Skeleton of tree-based set implementation:
;; same interface as list-based set.
(define (make-tree-set items)
  (lambda (op . args)
    (cond ((eq? op 'add-element) (...))
          ((eq? op 'remove-element) (...))
          ((eq? op 'contains?) (...))
          ((eq? op 'union) (...))
          ((eq? op 'intersection) (...))
          (else (error "unknown op: " op)))))

;; Usage, including mixing of implementations.
;; Assumes existence of empty-tree procedure to build
;; an empty tree.
(define a (make-tree-set (empty-tree)))
(define a (a 'add 1)) ; redefine a
(define a (a 'add 2)) ; redefine a again
(define b (make-list-set (list)))
(define b (b 'add 3))
(define c (a 'union b))