lect40-scope-objects
let over lambda

  1  #lang racket
  2  
  3  ;;;;;;;;;;; LET OVER LAMBDA
  4  ;;
  5  ;; Using closures to effect:
  6  ;;  - global variables
  7  ;;  - static fields
  8  ;;  - object fields
  9  ;;  - local variables
 10  
 11  
 12  
 13  ; NOTE: you must use #lang racket ('language: as determined in source')
 14  ; rather than advanced-student, to get the var-args syntax:
 15  (define (test-language-level a b . my-other-args)
 16    (length my-other-args))
 17  
 18  (test-language-level 91 92 93 94 95)
 19  
 20  
 21  ;;; We implement a random-number generator.
 22  ;;; We need (want) state to do this;
 23  ;;; version 1 will use (and set!) a global variable `seed`.
 24  ;;;
 25  
 26  (define seed 1)
 27  (define MAX-RAND 123)
 28  
 29  
 30  (define (next-rand-v1)
 31    (begin (set! seed (remainder (+ (* 23 seed) 17) MAX-RAND))
 32           seed))
 33  
 34  (define (set-seed!-v1 new-val)
 35    (set! seed new-val))
 36  
 37  
 38  
 39  
 40  "v1:"
 41  (next-rand-v1)
 42  (next-rand-v1)
 43  (next-rand-v1)
 44  (next-rand-v1)
 45  (next-rand-v1)
 46  "re-setting v1:"
 47  (set-seed!-v1 1)
 48  (next-rand-v1)
 49  (next-rand-v1)
 50  
 51  (error "stopping after v1")
 52  
 53  ;;;;;;;;;;;;;;;;
 54  ;; v1 is nice, but it has a major problem:
 55  ;; since 'seed' is global, anybody can muss with that variable.
 56  
 57  ;; We want a variable that is local to just those two functions (methods).
 58  ;; At first, it seems like `let*` doesn't help -- we can't put it in just
 59  ;; one function (since the other needs access to that same local variable).
 60  ;; But: put a `let*` around *both* functions!
 61  
 62  ;; v2: a version where `seed` is 'private'.
 63  
 64  (define two-rng-funcs
 65    (let* {[seed 1]
 66           [MAX-RAND 123]
 67           [next-rand (lambda ()
 68                        (begin (set! seed (remainder (+ (* 23 seed) 17) MAX-RAND))
 69                               seed))]
 70           [set-seed! (lambda (new-val) (set! seed new-val))]}
 71      (list next-rand set-seed!)))
 72  
 73  (define next-rand-v2 (first two-rng-funcs))
 74  (define set-seed!-v2 (second two-rng-funcs))
 75  ;;; Note: the above is common enough that scheme provides 'match-define':
 76  ;;;   (match-define (list next-rand-v2 set-seed!-v2) two-rng-funcs)
 77  ;;;
 78  ;;; In python:   (x,y) = (3,4)
 79  ;;;              (nextRandv2, setSeedv2) = two-rng-funcs
 80  
 81  
 82  "v2:"
 83  (next-rand-v2)
 84  (next-rand-v2)
 85  (next-rand-v2)
 86  (set-seed!-v2 1)
 87  (next-rand-v2)
 88  (next-rand-v2)
 89  
 90  ;;; DEFINITION: the "closure" of a function:
 91  ;;;   the set of all
 92  ;;;   bindings(identifiers) which the function can refer to.
 93  ;;; Note that from the top-level,
 94  ;;; the id `next-rand-v2` is in scope,
 95  ;;; the id `seed` is not in scope,
 96  ;;; but it *is* in the function's scope.
 97  ;;; (Put another way: even though we finished eval'ing the let*
 98  ;;; a long time ago, the variable it created might live on inside
 99  ;;; a function's closure, so it can't be garbage collected.
100  ;;; Hopefully such variables were allocated on the heap,
101  ;;; not on the stack!)
102  
103  (error "stopping after v2")
104  
105  
106  ;;;;;;;;;;;;;;
107  ;; A version where we can make
108  ;; *multiple* pairs-of-functions-which-each-share-a-local-`seed`.
109  
110  
111  (define (rng-factory)
112    (let* {[sseed 1]
113           [MAX-RAND 123]
114           [next-rand (lambda ()
115                        (begin (set! sseed (remainder (+ (* 23 sseed) 17) MAX-RAND))
116                               sseed))]
117           [set-seed! (lambda (new-val) (set! sseed new-val))]}
118      (list next-rand set-seed!)))
119  
120  ;; The only difference in code between v2 and v3:
121  ;; the parens around 'rng-factory'!
122  
123    
124  (match-define (list next-rand-v3a set-seed!-v3a) (rng-factory))
125  (match-define (list next-rand-v3b set-seed!-v3b) (rng-factory))
126  
127  
128  
129  "v3a:"
130  (next-rand-v3a)
131  (next-rand-v3a)
132  (next-rand-v3a)
133  (set-seed!-v3a 1)
134  (next-rand-v3a)
135  "v3b:"
136  (next-rand-v3b)
137  (next-rand-v3b)
138  (next-rand-v3b)
139  (set-seed!-v3b 1)
140  (next-rand-v3b)
141  (next-rand-v3b)
142  
143  "continue using next-rand-v3a"
144  (next-rand-v3a)
145  (next-rand-v3a)
146  
147  (error "stopping after v3")
148  
149  ;;;;;;;;;;;;;;;;;;
150  ;; Currently, we have *pair*s of coupled functions;
151  ;; we don't have one individual 'random-number-object'.
152  ;; Let's make one object, and we'll send "messages" to that
153  ;; object, asking it to do stuff for us (This is the flavor of O.O.!)
154  ;;
155  ;;
156  ;; A version where instead of returning a list-of-functions,
157  ;; we return one "meta function" which dispatches to the 
158  ;; function that is being asked for:
159  ;; 
160  (define (new-rng)
161    (let* {[sseed 1]
162           [MAX-RAND 123]
163           [next-rand (lambda ()
164                        (begin (set! sseed (remainder (+ (* 23 sseed) 17) MAX-RAND))
165                               sseed))]
166           [set-seed! (lambda (new-val) (set! sseed new-val))]
167           }
168      (lambda (msg . other-args)
169        (cond [(symbol=? msg 'next)  (apply next-rand other-args)]
170              [(symbol=? msg 'seed!) (apply set-seed! other-args)]
171              [else (error 'rng (format "No such method recognized: ~a" msg))]))))
172    
173  
174  
175  
176  "v4a: (objects)"
177  (define r (new-rng))
178  (define s (new-rng))
179  (r 'next)
180  (r 'next)
181  (r 'next)
182  (r 'seed! 1)
183  (r 'next)
184  (r 'next)
185  "v4b:"
186  (s 'next)
187  (s 'next)
188  (s 'next)
189  (s 'next)
190  (s 'seed! 1)
191  (s 'next)
192  (s 'next)
193  
194  (error "stopping after v4")
195  
196  ;;;;;;;;;;;;;;;;
197  ;;; A sub-class:
198  ;;; "class niftier-rng extends rng":
199  ;;;
200  ;;; We add a new method `skip` (which advances the seed, but returns nothing useful),
201  ;;; and we override `next` so that it doubles the superclass's result.
202  ;;; We also add a new field, `name`.
203  ;;;
204  
205  (define (new-niftier-rng)
206    (let* {[super (new-rng)]  ; The superclass object.
207           [name "hello"]}    ; A new field, only in the subclass.
208      (lambda (msg . other-args)
209        (cond [(symbol=? msg 'skip) (begin (super 'next) "skipped")]
210              [(symbol=? msg 'next) (* 2 (super 'next))]
211              #;[(symbol=? msg 'get-seed) sseed]
212              ; This is what we *want* to return, but it'd be an error: sseed
213              ; is in super's scope, but not ours!
214              ; Our approach to implementing an object system can do most things,
215              ; but it can't emulate Java's 'protected' access
216              ; (since 'subclassing' this way is something any function can do).
217              ; One solution: In the superclass, have a 'secret key' that
218              ;    must be provided to access protected fields/methods;
219              ;    have a mechanism which provides that key only
220              ;    via a construct 'build-valid-subclass'.
221              [else (apply super msg other-args)]))))
222  
223  
224  ;;; Exercise: our methodology for faking objects (by using closures and
225  ;;; a 'dispatcher' function) does allow for calling superclass methods
226  ;;; (through a variable we conveniently named `super`).
227  ;;; However, how could we call methods in the *same* class?
228  ;;; Hint: include the dispatcher method inside the let*,
229  ;;; perhaps naming it `this`.
230  ;;; But `let*` won't quite work; you'll need `letrec`.
231  
232  
233  
234  
235  "v5 (subclassing)"
236  (define ss (new-niftier-rng))
237  (ss 'next)
238  (ss 'next)
239  (ss 'skip)
240  (ss 'next)
241  (ss 'seed! 1)
242  (ss 'next)
243  
244  (error "stopping after v5")
245  
246  
247  #| "Let over lambda":
248  The sandwiching of 'lambda' and 'let' is doing interesting things for us.
249  (And fwiw, recall that let can be re-written in terms of lambda...so
250   lambda alone is enough to implement objects!)
251  
252  Hey, our own language Q4 has both 'let' and 'lambda' --
253  that means we can essentially implement subclassing and polymorphism!
254  |#
255  
256  
257  
258  
259  
260  ;;;;;;;;;;;;;;;;;;;;;;;;;;;; Macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
261  
262  ;; I would *like to write something easier, to accomplish the above. E.g.:
263  #;(subclass rng
264              skip : (begin (super 'next) "skipped")
265              next : (* 2 (super 'next)))
266  ;; This couldn't be written exactly as-is, since the exprs like "skip" and ":"
267  ;; aren't meant to be evaluated before calling "subclass".
268  ;; We'd really like a *macro*: "subclass" could take in those bits of syntax,
269  ;;   and create a new piece of syntax [the big let*-over-lambda we wrote above],
270  ;;   and *then* we'd eval that.  This is a "macro" -- code that writes code.
271  ;;
272  ;;   Some early versions (the C preprocessor) had macros that were string -> string.
273  ;;   There are too many things that can go wrong, and the string doesn't have all
274  ;;   the info that's inherent to the syntax tree.
275  ;;   [See Scott §3.7 (p.159) for good explanation.]
276  ;;
277  ;;   So really, we want macros that work on syntax-trees -- they're   syntax -> syntax
278  ;;   (or in our O4 example, Expr -> Expr).
279  ;;
280  (define-syntax subclass
281    (syntax-rules (: <=)
282      [(subclass klass <= souperKlass
283                 (mthd : body)
284                 ...)
285       
286       (define (klass)
287         (let* {[souper (souperKlass)]}
288           (lambda (msg . args)
289             (cond [(symbol=? msg (quote mthd)) body]
290                   ...
291                   [else (apply souper msg args)]))))]))
292  
293  (subclass rng2 <= new-rng
294            (flap : 99)
295            (flop : "Belly"))
296  
297  
298  (define r2 (rng2))
299  (r2 'flap 2 3 4)
300  (r2 'flop)
301  (r2 'next)
302  (r2 'next)
303  
304  
305  ; Here is a "raw" macro -- a function that takes in syntax and returns syntax.
306  ; It doesn't use the higher-level "syntax-rules"; instead
307  ; it just uses the primitives:
308  ;  - "#`" (syntax-quote: convert directly to syntax)
309  ;  - "#," (syntax-unquote: eval, before the enclosing #` converts it to syntax.
310  ; They are themselves shorthand that can be replaced by:
311  ; making a list full of syntax-objects, and then combine those into a single syntax-of-a-list.
312  
313  (define-syntax (assert expr-stx)
314    #`(when (not #,(cadr (syntax->list expr-stx)))
315        (display (format "assert failed: ~a [line ~a]~n"
316                         (quote #,expr-stx)
317                         #,(syntax-line expr-stx)))))
318    
319    
320    
321  (assert (> pi (sqrt 10)))
322  
323  
324  ; Note that there is a 'define-syntax-rule',
325  ; which can be used in simply cases; it gets rid of the syntax quoting/unquoting:
326  
327  (define-syntax-rule (assert-v2 expr)
328    (when (not expr)
329      (display (format "assert-v2 failed: ~a [line ~a]~n"
330                       (quote expr)
331                       (syntax-line (syntax expr))))))
332  
333  (assert-v2 (> pi (sqrt 10)))
334  
335  ; For more on racket macros: see tutorial   http://www.greghendershott.com/fear-of-macros