summary refs log tree commit diff stats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
0 files changed, 0 insertions, 0 deletions
5'>15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
(define pi 3.141592654)

;; tagged data

(define attach-tag cons)
(define type-tag car)
(define contents cdr)

(define (make-square side)
  (attach-tag 'square side))

(define (make-circle radius)
  (attach-tag 'circle radius))

;; conventional style

(define (area shape)
  (cond ((eq? (type-tag shape) 'square)
	 (* (contents shape) (contents shape)))
	((eq? (type-tag shape) 'circle)
	 (* pi (contents shape) (contents shape)))
	(else (error "Unknown shape -- AREA"))))

(define (perimeter shape)
  (cond ((eq? (type-tag shape) 'square)
	 (* 4 (contents shape)))
	((eq? (type-tag shape) 'circle)
	 (* 2 pi (contents shape)))
	(else (error "Unknown shape -- PERIMETER"))))

;; Data-directed programming

(put 'square 'area (lambda (s) (* s s)))
(put 'circle 'area (lambda (r) (* pi r r)))
(put 'square 'perimeter (lambda (s) (* 4 s)))
(put 'circle 'perimeter (lambda (r) (* 2 pi r)))

(define (operate op obj)
  (let ((proc (get (type-tag obj) op)))
    (if proc
	(proc (contents obj))
	(error "Unknown operator for type"))))

(define (area shape)
  (operate 'area shape))

(define (perimeter shape)
  (operate 'perimeter shape))

;; message passing

(define (make-square side)
  (lambda (message)
    (cond ((eq? message 'area)
	   (* side side))
	  ((eq? message 'perimeter)
	   (* 4 side))
	  (else (error "Unknown message")))))

(define (make-circle radius)
  (lambda (message)
    (cond ((eq? message 'area)
	   (* pi radius radius))
	  ((eq? message 'perimeter)
	   (* 2 pi radius))
	  (else (error "Unknown message")))))

(define (operate op obj)
  (obj op))