#lang racket

;;;;;;;;;;; LET OVER LAMBDA
;;
;; Using closures to effect:
;;  - global variables
;;  - static fields
;;  - object fields
;;  - local variables



; NOTE: you must use #lang racket ('language: as determined in source')
; rather than advanced-student, to get the var-args syntax:
(define (test-language-level a b . my-other-args)
  (length my-other-args))

(test-language-level 91 92 93 94 95)


;;; We implement a random-number generator.
;;; We need (want) state to do this;
;;; version 1 will use (and set!) a global variable `seed`.
;;;

(define seed 1)
(define MAX-RAND 123)


(define (next-rand-v1)
  (begin (set! seed (remainder (+ (* 23 seed) 17) MAX-RAND))
         seed))

(define (set-seed!-v1 new-val)
  (set! seed new-val))




"v1:"
(next-rand-v1)
(next-rand-v1)
(next-rand-v1)
(next-rand-v1)
(next-rand-v1)
"re-setting v1:"
(set-seed!-v1 1)
(next-rand-v1)
(next-rand-v1)

(error "stopping after v1")

;;;;;;;;;;;;;;;;
;; v1 is nice, but it has a major problem:
;; since 'seed' is global, anybody can muss with that variable.

;; We want a variable that is local to just those two functions (methods).
;; At first, it seems like `let*` doesn't help -- we can't put it in just
;; one function (since the other needs access to that same local variable).
;; But: put a `let*` around *both* functions!

;; v2: a version where `seed` is 'private'.

(define two-rng-funcs
  (let* {[seed 1]
         [MAX-RAND 123]
         [next-rand (lambda ()
                      (begin (set! seed (remainder (+ (* 23 seed) 17) MAX-RAND))
                             seed))]
         [set-seed! (lambda (new-val) (set! seed new-val))]}
    (list next-rand set-seed!)))

(define next-rand-v2 (first two-rng-funcs))
(define set-seed!-v2 (second two-rng-funcs))
;;; Note: the above is common enough that scheme provides 'match-define':
;;;   (match-define (list next-rand-v2 set-seed!-v2) two-rng-funcs)
;;;
;;; In python:   (x,y) = (3,4)
;;;              (nextRandv2, setSeedv2) = two-rng-funcs


"v2:"
(next-rand-v2)
(next-rand-v2)
(next-rand-v2)
(set-seed!-v2 1)
(next-rand-v2)
(next-rand-v2)

;;; DEFINITION: the "closure" of a function:
;;;   the set of all
;;;   bindings(identifiers) which the function can refer to.
;;; Note that from the top-level,
;;; the id `next-rand-v2` is in scope,
;;; the id `seed` is not in scope,
;;; but it *is* in the function's scope.
;;; (Put another way: even though we finished eval'ing the let*
;;; a long time ago, the variable it created might live on inside
;;; a function's closure, so it can't be garbage collected.
;;; Hopefully such variables were allocated on the heap,
;;; not on the stack!)

(error "stopping after v2")


;;;;;;;;;;;;;;
;; A version where we can make
;; *multiple* pairs-of-functions-which-each-share-a-local-`seed`.


(define (rng-factory)
  (let* {[sseed 1]
         [MAX-RAND 123]
         [next-rand (lambda ()
                      (begin (set! sseed (remainder (+ (* 23 sseed) 17) MAX-RAND))
                             sseed))]
         [set-seed! (lambda (new-val) (set! sseed new-val))]}
    (list next-rand set-seed!)))

;; The only difference in code between v2 and v3:
;; the parens around 'rng-factory'!

  
(match-define (list next-rand-v3a set-seed!-v3a) (rng-factory))
(match-define (list next-rand-v3b set-seed!-v3b) (rng-factory))



"v3a:"
(next-rand-v3a)
(next-rand-v3a)
(next-rand-v3a)
(set-seed!-v3a 1)
(next-rand-v3a)
"v3b:"
(next-rand-v3b)
(next-rand-v3b)
(next-rand-v3b)
(set-seed!-v3b 1)
(next-rand-v3b)
(next-rand-v3b)

"continue using next-rand-v3a"
(next-rand-v3a)
(next-rand-v3a)

(error "stopping after v3")

;;;;;;;;;;;;;;;;;;
;; Currently, we have *pair*s of coupled functions;
;; we don't have one individual 'random-number-object'.
;; Let's make one object, and we'll send "messages" to that
;; object, asking it to do stuff for us (This is the flavor of O.O.!)
;;
;;
;; A version where instead of returning a list-of-functions,
;; we return one "meta function" which dispatches to the 
;; function that is being asked for:
;; 
(define (new-rng)
  (let* {[sseed 1]
         [MAX-RAND 123]
         [next-rand (lambda ()
                      (begin (set! sseed (remainder (+ (* 23 sseed) 17) MAX-RAND))
                             sseed))]
         [set-seed! (lambda (new-val) (set! sseed new-val))]
         }
    (lambda (msg . other-args)
      (cond [(symbol=? msg 'next)  (apply next-rand other-args)]
            [(symbol=? msg 'seed!) (apply set-seed! other-args)]
            [else (error 'rng (format "No such method recognized: ~a" msg))]))))
  



"v4a: (objects)"
(define r (new-rng))
(define s (new-rng))
(r 'next)
(r 'next)
(r 'next)
(r 'seed! 1)
(r 'next)
(r 'next)
"v4b:"
(s 'next)
(s 'next)
(s 'next)
(s 'next)
(s 'seed! 1)
(s 'next)
(s 'next)

(error "stopping after v4")

;;;;;;;;;;;;;;;;
;;; A sub-class:
;;; "class niftier-rng extends rng":
;;;
;;; We add a new method `skip` (which advances the seed, but returns nothing useful),
;;; and we override `next` so that it doubles the superclass's result.
;;; We also add a new field, `name`.
;;;

(define (new-niftier-rng)
  (let* {[super (new-rng)]  ; The superclass object.
         [name "hello"]}    ; A new field, only in the subclass.
    (lambda (msg . other-args)
      (cond [(symbol=? msg 'skip) (begin (super 'next) "skipped")]
            [(symbol=? msg 'next) (* 2 (super 'next))]
            #;[(symbol=? msg 'get-seed) sseed]
            ; This is what we *want* to return, but it'd be an error: sseed
            ; is in super's scope, but not ours!
            ; Our approach to implementing an object system can do most things,
            ; but it can't emulate Java's 'protected' access
            ; (since 'subclassing' this way is something any function can do).
            ; One solution: In the superclass, have a 'secret key' that
            ;    must be provided to access protected fields/methods;
            ;    have a mechanism which provides that key only
            ;    via a construct 'build-valid-subclass'.
            [else (apply super msg other-args)]))))


;;; Exercise: our methodology for faking objects (by using closures and
;;; a 'dispatcher' function) does allow for calling superclass methods
;;; (through a variable we conveniently named `super`).
;;; However, how could we call methods in the *same* class?
;;; Hint: include the dispatcher method inside the let*,
;;; perhaps naming it `this`.
;;; But `let*` won't quite work; you'll need `letrec`.




"v5 (subclassing)"
(define ss (new-niftier-rng))
(ss 'next)
(ss 'next)
(ss 'skip)
(ss 'next)
(ss 'seed! 1)
(ss 'next)

(error "stopping after v5")


#| "Let over lambda":
The sandwiching of 'lambda' and 'let' is doing interesting things for us.
(And fwiw, recall that let can be re-written in terms of lambda...so
 lambda alone is enough to implement objects!)

Hey, our own language Q4 has both 'let' and 'lambda' --
that means we can essentially implement subclassing and polymorphism!
|#





;;;;;;;;;;;;;;;;;;;;;;;;;;;; Macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; I would *like to write something easier, to accomplish the above. E.g.:
#;(subclass rng
            skip : (begin (super 'next) "skipped")
            next : (* 2 (super 'next)))
;; This couldn't be written exactly as-is, since the exprs like "skip" and ":"
;; aren't meant to be evaluated before calling "subclass".
;; We'd really like a *macro*: "subclass" could take in those bits of syntax,
;;   and create a new piece of syntax [the big let*-over-lambda we wrote above],
;;   and *then* we'd eval that.  This is a "macro" -- code that writes code.
;;
;;   Some early versions (the C preprocessor) had macros that were string -> string.
;;   There are too many things that can go wrong, and the string doesn't have all
;;   the info that's inherent to the syntax tree.
;;   [See Scott §3.7 (p.159) for good explanation.]
;;
;;   So really, we want macros that work on syntax-trees -- they're   syntax -> syntax
;;   (or in our O4 example, Expr -> Expr).
;;
(define-syntax subclass
  (syntax-rules (: <=)
    [(subclass klass <= souperKlass
               (mthd : body)
               ...)
     
     (define (klass)
       (let* {[souper (souperKlass)]}
         (lambda (msg . args)
           (cond [(symbol=? msg (quote mthd)) body]
                 ...
                 [else (apply souper msg args)]))))]))

(subclass rng2 <= new-rng
          (flap : 99)
          (flop : "Belly"))


(define r2 (rng2))
(r2 'flap 2 3 4)
(r2 'flop)
(r2 'next)
(r2 'next)


; Here is a "raw" macro -- a function that takes in syntax and returns syntax.
; It doesn't use the higher-level "syntax-rules"; instead
; it just uses the primitives:
;  - "#`" (syntax-quote: convert directly to syntax)
;  - "#," (syntax-unquote: eval, before the enclosing #` converts it to syntax.
; They are themselves shorthand that can be replaced by:
; making a list full of syntax-objects, and then combine those into a single syntax-of-a-list.

(define-syntax (assert expr-stx)
  #`(when (not #,(cadr (syntax->list expr-stx)))
      (display (format "assert failed: ~a [line ~a]~n"
                       (quote #,expr-stx)
                       #,(syntax-line expr-stx)))))
  
  
  
(assert (> pi (sqrt 10)))


; Note that there is a 'define-syntax-rule',
; which can be used in simply cases; it gets rid of the syntax quoting/unquoting:

(define-syntax-rule (assert-v2 expr)
  (when (not expr)
    (display (format "assert-v2 failed: ~a [line ~a]~n"
                     (quote expr)
                     (syntax-line (syntax expr))))))

(assert-v2 (> pi (sqrt 10)))

; For more on racket macros: see tutorial   http://www.greghendershott.com/fear-of-macros