cbv λ-calculus interpreter with unbounded continuations

interp.rkt

#lang racket
(require racket/dict) ;; for dict-lookup for env

; eval-apply interpreter for call-by-value λ-calculus with call/cc
; scroll down to test1, test2 and yin & yang to see example programs

(define id (lambda (x) x))
(define initev '())
(define (ext k v e) 
  (cons (cons k v) e))
(define (lookup k e) (dict-ref e k))

(define (interp p) (eval p initev id))
(define (eval p e c)
  (cond
   [(const? p) (c (getconst p))]
   [(lambda? p) (c (mk-lambda p e))]
   [(callcc? p) (eval (body p)
                      (ext (fp p)
                           (lambda (r _) (c r))
                           e)
                      c)]
   [(yin? p) (display "yin\n") (eval (cadr p) e c)]
   [(yang? p) (display "yang\n") (eval (cadr p) e c)]
   [(apply? p) (apply p e c)]
   [(var? p) (c (lookup p e))]))

(define (apply p e c)
  (eval (operator p) e (lambda (f) (eval (operand p) e (lambda (a) (f a c))))))

(define (mk-lambda p e)
  (lambda (a c)
    (eval (body p) (ext (fp p) a e) c)))
(define (var? p) #t)
(define (const? p) (number? p))
(define (getconst p) p)
(define (lambda? p) (and (list? p) (eq? (car p) 'lambda)))
(define (callcc? p) (and (list? p) (eq? (car p) 'call-cc)))
(define (yin? p) (and (list? p) (eq? (car p) 'yin)))
(define (yang? p) (and (list? p) (eq? (car p) 'yang)))

(define (fp p) (caadr p))
(define (body p) (caddr p))
(define (apply? p) (list? p))
(define (operator p) (car p))
(define (operand p) (cadr p))


(define I '(lambda (x) x))
(define K '(lambda (x) (lambda (y) x)))
(define S '(lambda (x) (lambda (y) (lambda (z) ((x z) (y z))))))
(define Omega '((lambda (x) (x x)) (lambda (x) (x x))))


(define test-clause '(lambda (return) (return 3)))

(define test1s "(K 0 ((λ r. r 3) I))") 
(define test2s "(call-cc (k) (K 0 ((λ r. r 3) k)))")
(define test1 `((,K 0) (,test-clause ,I)))
(define test2 `(call-cc (k) ((,K 0) (,test-clause k))))

(display "Trying out: ")
(display test1s)
(display "...\n")
(interp test1)
(display "Trying out: ")
(display test2s)
(display "...\n")
(interp test2)

(define yin '((lambda (cc) (yin cc)) (call-cc (c) c)))
(define yang '((lambda (cc) (yang cc)) (call-cc (c) c)))
(define yy `(,yin ,yang))
;; uncomment the following line to see the yin-yang example
;; (interp yy)