src/sicp/ex4_51.rkt

   1 #lang racket
   2
   3 ;;; assignment
   4 (define (analyze-assignment expr)
   5   (let ([var (assignment-var expr)]
   6         [vproc (analyze (assignment-value expr))])
   7     (lambda (env succeed fail)
   8       (vproc env
   9              (lambda (val fail2)
  10                (let ([old-val (lookup-variable-value var env)])
  11                  (set-variable-value! var val)
  12                  (succeed 'ok
  13                           (lambda ()
  14                             (set-variable-value! var old-val env)
  15                             (fail2)))))
  16              fail))))
  17
  18 ;; permenent-set!
  19 ;;; assignment
  20 (define (analyze-permanent-assignment expr)
  21   (let ([var (perm-assignment-var expr)]
  22         [vproc (analyze (perm-assignment-value expr))])
  23     (lambda (env succeed fail)
  24       (vproc env
  25              (lambda (val fail2)
  26                (set-variable-value! var val)
  27                (succeed 'ok fail2))
  28              fail))))