-
Notifications
You must be signed in to change notification settings - Fork 1
/
g.scm
84 lines (64 loc) · 2.12 KB
/
g.scm
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
(define (send message object . args)
(let ((method (method-lookup object message)))
(cond ((procedure? method) (apply method args))
((null? method)
(error "send" "Message not understood: " message))
(else
(error "send" "Inappropriate result of method lookup: "
method)))))
(define (virtual-operations object)
(send 'set-self! object object))
(define (new-instance class . parameters)
(let ((instance (apply class parameters)))
(virtual-operations instance)
instance))
(define (new-part class . parameters)
(apply class parameters))
(define (method-lookup object selector)
(cond ((procedure? object) (object selector))
(else
(error "method-lookup"
"Inappropriate object in method-lookup: "
object))))
(define (object)
(let ((super '())
(self 'nil))
(define (set-self! object-part)
(set! self object-part))
(define (self message)
(cond ((eqv? message 'set-self!) set-self!)
(else '())))
self))
(define (x)
(let ((super (new-part object))
(self 'nil))
(let ((x-state 1))
(define (get-state) x-state)
(define (res)
(send 'get-state self))
(define (set-self! object-part)
(set! self object-part)
(send 'set-self! super object-part))
(define (self message)
(cond ((eqv? message 'get-state) get-state)
((eqv? message 'res) res)
((eqv? message 'set-self!) set-self!)
(else (method-lookup super message))))
self)))
(define (y)
(let ((super (new-part x))
(self 'nil))
(let ((y-state 2))
(define (get-state) y-state)
(define (set-self! object-part)
(set! self object-part)
(send 'set-self! super object-part))
(define (self message)
(cond ((eqv? message 'get-state) get-state)
((eqv? message 'set-self!) set-self!)
(else (method-lookup super message))))
self)))
(define a (new-instance x))
(define b (new-instance y))
(format #t "a: ~a~%" (send 'res a))
(format #t "b: ~a~%" (send 'res b))