;; ** Simulation of web interactions with a CPS converter (not an
;; ** interpreter)

#lang racket

(define error raise-user-error)

(define (nothing-to-do ignored)
  (error 'nothing-to-do "No computation to resume."))

(define resumer (box nothing-to-do))

(define (web-display n)
  (set-box! resumer nothing-to-do)
  (error 'web-display "~s" n))

(define (web-read/k prompt k)
  (set-box! resumer k)
  (error 'web-read
         "enter (submit N) to continue the following\n  ~a:"
         prompt))

(define (submit n)
  ;; to avoid mistakes, we clear out `resumer' before invoking it
  (let ([k (unbox resumer)])
    (set-box! resumer nothing-to-do)
    (k n)))

(define-syntax CPS
  (syntax-rules (+ lambda web-read web-display) ;*** keywords
    [(CPS (+ E1 E2))
     (lambda (k)
       ((CPS E1)
        (lambda (v1)
          ((CPS E2)
           (lambda (v2)
             (k (+ v1 v2)))))))]
    [(CPS (web-read E))
     (lambda (k)
       ((CPS E)
        (lambda (val)
          (web-read/k val k))))]
    [(CPS (web-display E))
     (lambda (k)
       ((CPS E)
        (lambda (val)
          (web-display val))))]
    [(CPS (lambda (arg) E))
     (lambda (k)
       (k (lambda (arg cont)
            ((CPS E)
             cont))))]
    [(CPS (E1 E2))
     (lambda (k)
       ((CPS E1)
        (lambda (v1)
          ((CPS E2)
           (lambda (v2)
             (v1 v2 k))))))]
    ;; the following pattern ensures that the last rule is used only
    ;; with simple values and identifiers
    [(CPS (x ...))
     ---syntax-error---]
    [(CPS V) ; <-- only numbers, other literals, and identifiers
     (lambda (k)
       (k V))]))

(define-syntax CPS-code
  (syntax-rules (define)
    [(CPS-code (define (id arg) E) more ...)
     ;; simple translation to `lambda'
     (CPS-code (define id (lambda (arg) E)) more ...)]
    [(CPS-code (define id E) more ...)
     (begin (define id ((CPS E) (lambda (x) x)))
            (CPS-code more ...))]
    [(CPS-code last-expr)
     ((CPS last-expr) web-display)]
    [(CPS-code) ; happens when there is no plain expr at
     (begin)])) ; the end so do nothing in this case