blob: dd47bd13d46c86fb61c2ce720bb5d36d9e3d6d72 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
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))
|