lect13a-scope-objects

  1  #lang scheme
  2  
  3  
  4  ; NOTE: you must use hte langugae level 'module',
  5  ; rather than advanced-student, to get the var-args syntax:
  6  (define (test-language-level a b . otherArgs)
  7    (length otherArgs))
  8  
  9  
 10  
 11  ;;; We implement a random-number generator.
 12  ;;; We need state to do this;
 13  ;;; version 1 will use (and set!) a global variable `seed`.
 14  ;;;
 15  (define seed 1)
 16  (define MAX-RAND 123)
 17  
 18  (define (next-rand-v1)
 19    (begin (set! seed (remainder (+ (* 23 seed) 17) MAX-RAND))
 20           seed))
 21  
 22  (define (set-seed!-v1 new-val)
 23    (set! seed new-val))
 24  
 25  
 26  ;;;;;;;;;;;;;;;;
 27  
 28  ;; A version with 'seed' being 'private'.
 29  
 30  (define two-rng-funcs
 31    (let* {[seed 1]
 32           [MAX-RAND 123]
 33           [next-rand (lambda ()
 34                        (begin (set! seed (remainder (+ (* 23 seed) 17) MAX-RAND))
 35                               seed))]
 36           [set-seed! (lambda (new-val) (set! seed new-val))]}
 37      (list next-rand set-seed!)))
 38  
 39  (define next-rand-v2 (first two-rng-funcs))
 40  (define set-seed!-v2 (second two-rng-funcs))
 41  ;;; Note: the above is common enough that scheme provides 'match-define':
 42  ;;; (match-define (list next-rand-v2 set-seed!-v2) two-rng-funcs)
 43  
 44  
 45  
 46  ;;;;;;;;;;;;;;
 47  ;; A version where we can make
 48  ;; *multiple* pairs-of-functions-which-share-a-local-`seed`.
 49  
 50  
 51  (define (rng-factory)
 52    (let* {[sseed 1]
 53           [MAX-RAND 123]
 54           [next-rand (lambda ()
 55                        (begin (set! sseed (remainder (+ (* 23 sseed) 17) MAX-RAND))
 56                               sseed))]
 57           [set-seed! (lambda (new-val) (set! sseed new-val))]}
 58      (list next-rand set-seed!)))
 59  
 60    
 61  (match-define (list next-rand-v3a set-seed!-v3a) (rng-factory))
 62  (match-define (list next-rand-v3b set-seed!-v3b) (rng-factory))
 63  
 64  "using next-rand-v3a"
 65  (next-rand-v3a)
 66  (next-rand-v3a)
 67  
 68  "using next-rand-v3b"
 69  (next-rand-v3b)
 70  (next-rand-v3b)
 71  (next-rand-v3b)
 72  
 73  "(And a third call to 3a:)"
 74  (next-rand-v3a)
 75  
 76  
 77  ;;;;;;;;;;;;;;;;;;
 78  ;; A version where instead of returning a list-of-functions,
 79  ;; we return one "meta function" which dispatches to the 
 80  ;; function that is being asked for:
 81  ;; 
 82  (define (new-rng)
 83    (let* {[sseed 1]
 84           [MAX-RAND 123]
 85           [next-rand (lambda ()
 86                        (begin (set! sseed (remainder (+ (* 23 sseed) 17) MAX-RAND))
 87                               sseed))]
 88           [set-seed! (lambda (new-val) (set! sseed new-val))]
 89           }
 90      (lambda (msg . other-args)
 91        (cond [(symbol=? msg 'next)  (apply next-rand other-args)]
 92              [(symbol=? msg 'seed!) (apply set-seed! other-args)]
 93              [else (error 'rng (format "No such method recognized: ~a" msg))]))))
 94    
 95  
 96  
 97  
 98  ;;;;;;;;;;;;;;;
 99  ;;;  A sub-class
100  
101  (define (new-super-rng)
102    (let* {[super (new-rng)]  ; The superclass object.
103           [name "hello"]}    ; A new field, only in the subclass.
104      (lambda (msg . other-args)
105        (cond [(symbol=? msg 'skip) 43]
106              [(symbol=? msg 'next) (begin (super 'seed! 17) (super 'next))]
107              #;[(symbol=? msg 'get-seed) sseed]
108              ; This is what we *want* to return, but it'd be an error: sseed
109              ; is in super's scope, but not ours!
110              ; Our approach to implementing an object system can do most things,
111              ; but it can't emulate Java's 'protected' access.
112              [else (apply super msg other-args)]))))
113  
114  
115  ;;; Exercise: our methodology for faking objects (by using closures and
116  ;;; a 'dispatcher' function does allow for calling superclass methods
117  ;;; (through a variable we conveniently named `super`).
118  ;;; However, how could we call methods in the *same* class?
119  ;;; Hint: include the dispatcher method inside the let*,
120  ;;; perhaps naming it `this`.
121  ;;; But 'let*' won't quite work; what let-like construct will you need?
122  
123  "v1:"
124  (next-rand-v1)
125  (next-rand-v1)
126  (next-rand-v1)
127  (set-seed!-v1 1)
128  (next-rand-v1)
129  (next-rand-v1)
130  
131  "v2:"
132  (next-rand-v2)
133  (next-rand-v2)
134  (next-rand-v2)
135  (set-seed!-v2 1)
136  (next-rand-v2)
137  (next-rand-v2)
138  
139  "v3a:"
140  (next-rand-v3a)
141  (next-rand-v3a)
142  (next-rand-v3a)
143  (set-seed!-v3a 1)
144  (next-rand-v3a)
145  (next-rand-v3a)
146  "v3b:"
147  (next-rand-v3b)
148  (next-rand-v3b)
149  (next-rand-v3b)
150  (set-seed!-v3b 1)
151  (next-rand-v3b)
152  (next-rand-v3b)
153  
154  
155  "v4a: (objects)"
156  (define r (new-rng))
157  (define s (new-rng))
158  (r 'next)
159  (r 'next)
160  (r 'next)
161  (r 'seed! 1)
162  (r 'next)
163  (r 'next)
164  "v4b:"
165  (s 'next)
166  (s 'next)
167  (s 'next)
168  (s 'seed! 1)
169  (s 'next)
170  (s 'next)
171  
172  "v5 (subclassing)"
173  (define ss (new-super-rng))
174  (ss 'next)
175  (ss 'next)
176  (ss 'skip)
177  (ss 'next)