src/sicp/ex4_54.rkt

   1 #lang racket
   2
   3 (define (assert? expr) (tagged-list? expr 'assert))
   4
   5 (define (assert-predicate expr) (first (rest expr)))
   6
   7 (define (analyze-assert exp)
   8   (let ((pproc (analyze (assert-predicate exp))))
   9     (lambda (env succeed fail)
  10       (pproc env
  11              (lambda (pred-value fail2)
  12                (if (not (true? pred-value))
  13                    (fail)
  14                    (succeed 'ok fail2)))
  15              fail))))