Skip to content

Instantly share code, notes, and snippets.

@co-dan co-dan/interp.rkt
Created Jul 19, 2016

Embed
What would you like to do?
cbv λ-calculus interpreter with unbounded continuations
#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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.