The Black Reflective Tower of Interpreters
Walkthrough: Debugging
black
(define foo (lambda (f) (lambda (x) (lambda () (f (+ x 1))))))
(define thunk ((foo 2) 3))
(thunk)
(old-cont 'ok)
;; (exec-at-metalevel (load "break.blk"))
(inspect thunk)
f
(set! f (lambda (x) (* 2 x)))
(exit 'done)
(thunk)
(thunk)
(define thunk2 ((foo 2) 3))
(thunk2)
(old-cont 'ok)
;; (exec-at-metalevel (load "examples/multn.blk"))
(thunk2)
(1 2 3 4)
(exec-at-metalevel (begin
))
multn.blk
(let ((original-base-apply base-apply))
(set! base-apply
(lambda (operator operand env cont)
(cond ((number? operator)
(base-eval (cons '* (cons operator operand)) env cont))
(else
(original-base-apply operator operand env cont))))))
break.blk (relevant excerpt)
(define (loop prompt env ans)
(newline)(write ans)(newline)
(display prompt)(display "> ")
(base-eval (read) env (lambda (ans) (loop prompt env ans))))
(define (eval-inspect closure env cont)
(base-eval closure env (lambda (closure)
(let ((lambda-env (car (cdr (cdr (cdr closure))))))
(let ((result (loop "inspect" lambda-env 'inspect-loop)))
(newline)(write 'inspect-end)(newline)
(cont result))))))
(let ((original-eval-application eval-application))
(set! eval-application
(lambda (exp env cont)
(cond
((eq? (car exp) 'inspect)
(eval-inspect (car (cdr exp)) env cont))
(else
(original-eval-application exp env cont))))))
Example: Instrumentation
(exec-at-metalevel (load "examples/taba.blk"))
(load "examples/cnv.scm")
(taba (cnv walk) (cnv '(1 2 3) '(a b c)))
Example: Meta-Level Undo
(exec-at-metalevel (load "examples/undo.blk"))
(exec-at-metalevel (define old-eval-var eval-var))
(exec-at-metalevel (set! eval-var (lambda (e r k) (if (eq? e 'n) (k 0) (old-eval-var e r k)))))
(define n 1)
n
(exec-at-metalevel (eq? old-eval-var eval-var))
(exec-at-metalevel (undo!))
n
(exec-at-metalevel (eq? old-eval-var eval-var))