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