CCCPaste

‘defer’ version 2

(define (procedure1)
  (define exit-procs '())
  (define-syntax defer
    (syntax-rules ()
      ((defer (proc))
       (set! exit-procs (cons (cons proc '()) exit-procs)))
      ((defer (proc arg ...))
       (let ((evaluated-args (list arg ...)))
         (set! exit-procs (cons (cons proc evaluated-args)
                                exit-procs))))))
  (dynamic-wind
    (lambda () #f)
    (lambda ()
      (defer (display "Goodbye, world!\n"))
      (display "Hello, world!\n"))
    (lambda ()
      (display "Leaving procedure1.\n")
      (let loop ((p exit-procs))
        (cond ((pair? p)
               (let ((proc-and-args (car p))
                     (rest (cdr p)))
                 (let ((proc (car proc-and-args))
                       (args (cdr proc-and-args)))
                   (apply proc args)
                   (loop rest)))))))))

(procedure1)