;; ** A language that is CPS-transformed (not an interpreter)

#lang racket

(define (call-k f k)
  (f (lambda (val cont) (k val)) k))

(define-syntax CPS
  (syntax-rules (+ lambda)
    [(CPS (+ E1 E2))
     (lambda (k)
       ((CPS E1)
        (lambda (v1)
          ((CPS E2)
           (lambda (v2)
             (k (+ v1 v2)))))))]
    [(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)
     (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 expr more ...)
     (begin ((CPS expr) (lambda (x) x))
            (CPS-code more ...))]
    [(CPS-code) (begin)])) ; done

(CPS-code (call-k (lambda (abort) (+ 1 (abort 2))))
          (+ 100 (call-k (lambda (abort) (+ 1 (abort 2))))))