#lang racket

;;;;; Creating an Object System
;;;;; in Six Ten-Minute Steps

;;;;; (skip to "START" below)



;;;; prologue: our chapter-headers:
;;;
(define VERSIONS
  '("a var local to two functions (not global) -- in the *closure* of each."
    "*creating* pairs of functions which share locals -- but they are two funcs, not one object."
    "objects -- you pass it a message, and the functions’ shared vars are fields"
    "demo’ing subclassing: overriding and adding new methods-to-subclass, albeit w/o ‘protected’ access"
    "a macro, adding new syntax, in this case convenient for making subclasses."
    "macros -- further unrelated examples"
    ))

(define (start-next-version i)
  7)
#|  (define i-1 (sub1 i))
  (define max (length VERSIONS))
  (when (and (< 0 i-1) (< i-1 max)) (printf "That was v.~a: ~a~n" i-1 (list-ref VERSIONS i-1)))
  (when (<= i (length VERSIONS)) (printf "Next up: v.~a: ~a~n~n~n" i (list-ref VERSIONS i)))
  (when (> i MAX-VERSION) (error 'start-next-version "stay tuned!"))|#

(define MAX-VERSION 7) ; which version to run through.

      

; NOTE: this file uses #lang racket ('language: as determined in source')
; rather than advanced-student.
; This is so that we can get both var-args, and assigning-to-variables (`set!`):
;
(define (how-many-args-after-the-first-two  a b . my-other-args)
  ; any arguments beyond a,b are bundled together into the list `my-other-args`:
  (length my-other-args))
(module+ test
  (require rackunit)
  (check-equal? (how-many-args-after-the-first-two  91 92 93 94 95) 3))





;;;;;;;;;;;;;;;;;;;;;;;;;;;;  START  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; Creating an Object System
;;;;; in Six Ten-Minute Steps


(start-next-version 1)


;;;;;;;;;;;;;; Running example: a random-number-generator ;;;;;;;;;;;;;;;;;
;; We have two methods, `next-rand` and `set-seed!`;
;; these two methods need to share state (the common `seed` variable).
;;


#|
class Rng {
    private final static int MAX_RAND = 101;

    private int seed = 0;

    public int nextRand( /* Rng this */ ) {
        this.seed = (23*this.seed + 17) % MAX_RAND;
        return this.seed;
        }

    public setSeed( /* Rng this, */ int new_seed ) { this.seed = Math.abs(new_seed) % MAX_RAND; }
    }
|#


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




;;; 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 0)
(define MAX-RAND 101)


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

(define (set-seed!-v1 new-val)
  (set! seed new-val)) ; or better: set to (remainder (abs new-val) MAX-RAND)




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


(start-next-version 2)

;;;;;;;;;;;;;;;;
;; 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 also 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 0]
         [MAX-RAND 101]
         [next-rand (λ ()
                      (begin (set! seed (remainder (+ (* 23 seed) 17) MAX-RAND))
                             seed))]
         [set-seed! (lambda (new-val) (set! seed (remainder (abs new-val) MAX-RAND)))]}
    (list next-rand set-seed!)))

(define next-rand-v2 (first  two-rng-funcs))
(define set-seed!-v2 (second two-rng-funcs))
;;; Note: the above two lines are 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)
(set! seed 999)    ; no effect (whew) -- `seed` is "private".
(set! MAX-RAND 0)  ; no effect
(next-rand-v2)
(next-rand-v2)
"re-setting seed to 0"
(set-seed!-v2 0)   ; "call a setter"
(next-rand-v2)
(next-rand-v2)

;;; DEFINITION: the "closure" of a function:
;;;   An environment with bindings for all the function's free variables.
;;; 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 (its closure).
;;; (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 yet!
;;; Hopefully such variables were allocated on the heap, not on the stack!)



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


(define (rng-factory)
  (let* {[sseed 0]
         [MAX-RAND 101]
         [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)
"re-setting a's seed to 0"
(set-seed!-v3a 0)
(next-rand-v3a)
"v3b:"
(next-rand-v3b)
(next-rand-v3b)
(next-rand-v3b)
"re-setting b's seed to 0"
(set-seed!-v3b 0)
(next-rand-v3b)
(next-rand-v3b)
(next-rand-v3b)

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

(start-next-version 4)
;;;;;;;;;;;;;;;;;;
;; 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 0]
         [MAX-RAND 101]
         [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))]))))
  
#|  Momentarily ignoring the 'other-args', 'apply':

    (lambda (msg)
      (cond [(symbol=? msg 'next)  (next-rand)]
            [(symbol=? msg 'seed!) (set-seed! (first other-args))]
            [else (error 'rng (format "No such method recognized: ~a" msg))]))))
|#


"v4: (objects)"
(define r (new-rng))
(define s (new-rng))

"call r.next()"
(r 'next)
(r 'next)
(r 'next)
"reset r's seed"
(r 'seed! 0)
(r 'next)
"call s.next():"
(s 'next)
(s 'next)
(s 'next)
(s 'next)
"reset s's seed"
(s 'seed! 0)
(s 'next)
(s 'next)
(s 'next)

"resume w/ r.next():"
(r 'next)





(start-next-version 5)
;;;;;;;;;;;;;;;;
;;; 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/HACK: 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 you might name '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)
"reset the seed"
(ss 'seed! 0)
(ss 'next)




#| "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 E4 has both 'let' and 'lambda' --
that means we can essentially implement subclassing and polymorphism!
|#






(start-next-version 6)
;;;;;;;;;;;;;;;;;;;;;;;;;;;; Macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; btw:   https://github.com/shriram/xkcd-3062


;; I would *prefer* to write something easier, to accomplish the above. E.g.:
#;(subclass niftier-rng2 <= 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".
;; And `super` isn't an already-defined-variable, in the above!
;; 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.
;;      e.g.   `#define sqr(x) = x*x`
;;   and then a pre-processor turns the string `sqr(7)` into `7*7`, as desired.
;;    But beware: `sqr(2+3)` becomes `2+3*2+3`, which is *not* desired.
;;    You can fix that by adding parens: `#define sqr(x) = (x)*(x)`
;;   [Still, see Scott &sect;3.7 (p.159) for more examples.]
;;
;;   Even then though, consider: `sqr(n++)` -- this will expand into having `n` incremented twice!
;;   [this is problematic with anything that both returns a value *and* changes-state].
;;
;;
;;   So really, we want macros that work on syntax-trees -- they're   syntax -> syntax
;;   (or in our E4 terminology, 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)

#| An issue: Hygiene.

Unfortuately, we CANNOT yet write exactly what we wanted:

(subclass niftier-rng2 <= new-rng
          (skip : (begin (souper 'next) "skipped"))
          (next : (* 2 (souper 'next))))

If we do that, we get an error 'souper' is an unbound identifier.
"But that's what we want: we want to write code which uses an identifier
which the macro will introduce (later)."
  [So our use case is more complicated than many macros that don't want that.]
However, what if 'souper' were an already-defined variable, and that's
we wanted our (macro-expanded) code to be referring to?
I mean, we don't want our macro's internal/local variables to suddenly start
interfering with other people's code/variables; that's a basic example of
breaking encapsulation.

Naive macro systems used to allow that.
But better macro systems follow "hygiene" -- any variables/symbols they
introduce in expansion won't be confusable with the caller's code.

So, alas, our example of `niftier-rng` is actually wanting to
delve into "unsafe macros" (well, unhygienic).
This can certainly be done, but rather than `define-syntax` it would
need to use the lower-level, primitive `syntax-rules` (see docs).
|#


(start-next-version 7)

; One final macro example:


; The easiest way to write a macro is using the higher-level "define-syntax-rule".
; Although it looks a lot like a regular function,
; it is actually being passed syntax, and returning syntax
; (which gets expanded at "compile time", and so at run-time it's the
; expanded-syntax which is actually being interpreted).
;
(define-syntax-rule (assert-v1 expr)
  (when (not expr)
    (display (format "assert-v1 failed, line ~a: ~a~n"
                     (syntax-line (syntax expr))
                     (quote expr)))))

"This assert should fail (and, the next too):"
(assert-v1 (> pi (sqrt 10)))


; `define-syntax-rule` is a wrapper over `define-syntax`, which is
; explicit about how it (is just a function that) takes in syntax
; and returns syntax.
;
; It just uses the syntax "primitives":
;  - "#`" or "syntax-quote": return the following expression's syntax-struct (no eval'ing)
;  - "#," or "syntax-unquote": (like unquote, you write this *inside* something passed to syntax-quote):
;       eval the following expression, and then return the syntax-struct of that result.
; These two are themselves further shorthand that can be replaced by:
; manually creating a list full of syntax-structs and use them to
; create a single syntax-struct-for-a-list.

; Btw, this example uses another facet of racket's syntax-structs:
; they include the original syntax, AND extra fields about the source location (file & line-number).
; So the `syntax-line` below is just the getter for the `line` field of a `syntax` struct.

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

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






(start-next-version 8)
; For more on racket macros: see tutorial   http://www.greghendershott.com/fear-of-macros