a5.rkt

;; From video lecture: stack-passing interpreters and continuation-passing style (CPS)
;; CEK. Stack-passing style interpreters
#lang racket

(require racket/trace)

(define my* (lambda (x y) (* x y)))

;; Direct-style implementation of the factorial function, n!
(define (factorial n)
  (if (= n 0)
      1
      (my* n (factorial (- n 1)))))

(trace factorial)
(trace my*)
;;(factorial 5)

;; Trace is
;; >(factorial 2)
;; > (factorial 1)
;; > >(factorial 0)
;; < <1
;; < 1
;; <2
;; 2

(define (factorial-tail n acc)
  (if (= n 0)
      acc
      (factorial-tail (- n 1) (my* n acc))))

(trace factorial-tail)
;;(factorial-tail 5 1)

;; >(factorial 2)
;; > (factorial 1)
;; > >(factorial 0)
;; < <1
;; < 1
;; <2
;; 2

(define my= (lambda (x y) (= x y)))
(define my- (lambda (x y) (- x y)))
(define myif (lambda (guard true false) (if (guard) (true) (false))))
(trace my=)
(trace my*)
(trace my-)
(trace myif)

;; Exercise (optional): rewrite factorial and factorial-tail with
;; calls to my=, my*, my-, and myif. Observe how they work. Does this
;; confirm what you're feeling about whether each of the calls are
;; tail-calls or not?

;; helpers direct-style factorial function
(define (factorial-rewritten n)
  (myif (lambda () (my= n 0))
        (lambda () 1)
        (lambda () (my* n (factorial-rewritten (my- n 1))))))

(trace factorial-rewritten)
;;(factorial-rewritten 2)

;; Challenge: can we write a version of factorial where *every* call
;; it makes is a tail-call?
;; Arguments are:
;;  - n, the number of which we're computing the factorial
;;  - acc, the accumulated factorial
;;  - continuation, a function we call with the result
;; Rule is: we are only allowed to make tail calls
(define (factorial-cps-zero n acc k)
  (if (= n 0)
      (k acc)
      (factorial-cps-zero (- n 1) (* n acc) k)))

(factorial-cps-zero 10 1 (lambda (x) (displayln (format "the result was ~a" x))))

(define (=k x y k) (k (= x y)))
(define (-k x y k) (k (- x y)))
(define (+k x y k) (k (+ x y)))
(define (*k x y k) (k (* x y)))

(define (factorial-cps-fixed n acc k)
  (=k n 0
      (lambda (x)
        ;; x gets filled in with (= n 0)
        (if x
            (k acc)
            (-k n 1 (lambda (minus-value) 
                      (*k n acc (lambda (times-value)
                                  (factorial-cps-zero minus-value times-value k)))))))))

(factorial-cps-fixed 10 1 (lambda (x) (displayln (format "via CPS, we computed ~a" x))))

;; Something to study for the exam: practice how to convert very
;; simple functions to CPS.
(define (fib-tail n n0 n1)
  (if (= n 0)
      n0
      (fib-tail (- n 1) n1 (+ n0 n1))))

(define (fib-tail-cps n n0 n1 k)
  (=k n 0 (lambda (eq)
            (if eq
                (k n0)
                (-k n 1 (lambda (n-minus-1)
                          (+k n0 n1 (lambda (n0-plus-n1)
                                      (fib-tail-cps n-minus-1 n1 n0-plus-n1 k)))))))))

;; Benchmarking of direct-style vs. tail-recursive style

(define (regfac n)
  (if (= n 0) 1 (* n (regfac (- n 1)))))

(define (regfac-tail n acc)
  (if (= n 0) acc (regfac-tail (- n 1) (* acc n))))

;; Perform these experiments on your own
;;(time (regfac 50000) (displayln "done"))
;;(time (regfac-tail 50000 1) (displayln "done"))

; Define interp-cek, a tail recursive (small-step) interpreter for the language:
;;;  e ::= (lambda (x) e)
;;;      | (e e)
;;;      | x
;;;      | (let ([x e]) e)   
;;;      | (call/cc e) 
;;;      | (if e e e)
;;;      | (and e e)
;;;      | (or e e)
;;;      | (not e)
;;;      | b
;;;  x ::= < any variable satisfying symbol? >
;;;  b ::= #t | #f

; You can use (error ...) to handle errors, but will only be tested on
; on correct inputs. The language should be evaluated as would the same subset 
; of Scheme/Racket. In order to implement call/cc properly, your interpreter
; must implement a stack (as opposed to using Racket's stack by making the
; interpreter directly recursive) yourself and then allow whole stacks to be
; used as first-class values, captured via the call/cc form. Because your 
; interpreter implements its own stack, it does not use Racket's stack,
; and so every call to interp-CEK must be in tail position!
; Use symbol 'halt for an initial, empty stack. When a value is returned
; to the 'halt continuation, that value is finally returned from interp-CEK.
; For first-class continuations, use a tagged `(kont ,k) form where k is the
; stack, just as in the CE interpreter you used a tagged `(closure ,lam ,env)
; form for representing closures.

;; defining what continuations could be
(define (continuation? k)
  (match k
    ['halt #t]
    [`(letk ,x ,body ,env ,(? continuation? kont)) #t]
    [_ #f]))

; For example:
;;; (interp-CEK `(call/cc (lambda (k) (and (k #t) #f))) (hash) 'halt)
; should yield a value equal? to #t, and
;;; (interp-CEK `(call/cc (lambda (k0) ((call/cc (lambda (k1) (k0 k1))) #f))) (hash) 'halt)
; should yield a value equal? to `(kont (ar #f ,(hash 'k0 '(kont halt)) halt))
(define (interp-CEK cexp [env (hash)] [kont 'halt])
  (displayln "The current stack is:")
  (pretty-print kont)
  (displayln "Current expression is:")
  (pretty-print cexp)
  
  ;; How do I return from the current continuation?
  ;;
  ;; Expect that kont is the stack and v is the value being returned
  ;; to the stack
  (define (return kont v)
    (match kont
      ['halt v]
      [`(letk ,x ,body ,env ,kont)
       ;;  Bind x to v within the environment `env`. Use that
       ;;  environment to then compute the value of body.
       (interp-CEK body (hash-set env x v) kont)]
      [`(andk ,e1 ,env ,kont)
       (if (not v)
           (return kont #f)
           )]
      [`(ar ,arg ,env ,kont)
       (interp-CEK arg env `(fn ,v ,kont))]
      [`(fn (closure (lambda (,x) ,body) ,env) ,kont)
       (interp-CEK body (hash-set env x v) kont)]
      [_ 'todo]))
  (match cexp
    [`(let ([,x ,rhs]) ,body)
     ;; How do we handle a let? First, compute the value of rhs.
     (interp-CEK rhs env `(letk ,x ,body ,env ,kont))]
    ;; Return the boolean value b
    [(? boolean? b) (return kont b)]
    [`(lambda (,x) ,body) 
     (return kont `(closure ,cexp ,env))]
    [`(and ,e0 ,e1)
     (interp-CEK e0 env `(andk ,e1 ,env ,kont))]
    [`(,fun ,arg)
     (interp-CEK fun env `(ar ,arg ,env ,kont))]
    [(? symbol? x) (return kont (hash-ref env x))]
    [else (error (format "Exp not recognized: ~a" cexp))]))