;; Caltech CS1 Fall 2008
;; Scheme code for lab 6
;; mvanier@cs.caltech.edu

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Adding units
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; represent objects

(define (make-meter length)
  (cons 'meter length))
(define (get-tag m) (car m))
(define (get-value m) (cdr m))
(define (meter? m)
  (and (pair? m) (eq? (get-tag m) 'meter)))
(define (make-foot length)
  (cons 'foot length))
(define (foot? m)
  (and (pair? m) (eq? (get-tag m) 'foot)))


;; object specific addition
(define (meter-add a b)
  (make-meter (+ (get-value a) (get-value b))))
(define (foot-add a b)
  (make-foot (+ (get-value a) (get-value b))))


;; conversion between types
(define meters-per-foot 0.3048)
(define (feet-to-meters a)
  (make-meter (* meters-per-foot (get-value a))))

(define feet-per-meter (/ 1 meters-per-foot))
(define (meters-to-feet a)
  (make-foot (* feet-per-meter (get-value a))))

;; revising length-add
(define (length-add a b)
  (cond ((and (meter? a) (meter? b)) 
         (meter-add a b))
        ((and (foot? a) (foot? b)) 
         (foot-add a b))
        ((and (foot? a) (meter? b))
         (meter-add (feet-to-meters a) b))
        ((and (meter? a) (foot? b))
         (meter-add  a (feet-to-meters b)))
        (else (error "length-add given incompatible units" a b))))

;; examples
(length-add (make-meter 1) (make-meter 1))
(length-add (make-foot 1)  (make-foot 1))
(length-add (make-meter 1) (make-foot 1))

;; more constructors

(define (make-centimeter length)
  (make-meter (/ length 100)))
(define (make-inch length)
  (make-foot (/ length 12)))
(define (make-kilometer length)
  (make-meter (* 1000 length)))

;; smart (type-aware) conversion
(define (get-meters length)
  (cond ((meter? length) length)
        ((foot? length) (feet-to-meters length))
        (else 
         (error "get-meters requires a length, but given" length))))
(define (get-feet length)
  (cond ((foot? length) length)
        ((meter? length) (meters-to-feet length))
        (else 
         (error "get-feet requires a length, but given" length))))

;; examples

(get-meters (make-meter 1))
(get-meters (make-foot 3))
;;(get-meters 4)

;; another add
;; (define (length-add a b)
;;   (meter-add (get-meter a) (get-meter b)))
;; what does this return when adding feet?

;; other types / units
(define (make-gram mass)   (cons 'gram mass))
(define (make-second time) (cons 'second time))
(define minutes-per-second 60)
(define (make-minute time) 
  (make-second 
   (* time minutes-per-second)))
(define (gram? m)
  (and (pair? m) (eq? 'gram (get-tag m))))
(define (second? m)
  (and (pair? m) (eq? 'second (get-tag m))))

;; detecting types
(define (length? a)
  (or (meter? a) (foot? a)))
(define (mass? a)
  (gram? a))
(define (time? a)
  (second? a))

(define (second-add a b)
  (make-second (+ (get-value a) (get-value b))))

(define (time-add a b)
  (cond ((and (second? a) (second? b))
         (second-add a b))
        (else 
         (error "incompatible types" a b))))

;; unit addition

(define (unit-add a b)
  (cond ((and (length? a) (length? b))
         (length-add a b))
        ((and (time? a) (time? b))
         (time-add a b))
        ((and (mass? a) (mass? b))
         (mass-add a b))
        (else 
         (error "incompatible units" a b))))

;; examples
(unit-add (make-meter 1) (make-foot 1))
(unit-add (make-second 1) (make-minute 2))
;;(unit-add (make-second 3) (make-foot 1))