home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / s / s48.zip / MISC / WIND-TES.SCM < prev    next >
Text File  |  1992-06-17  |  1KB  |  52 lines
  1. ; Copyright (c) 1992 by Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. ; The correct output is something like this:
  5. ;   wind-1  f: 1
  6. ;   wind-2  f: 2
  7. ;   before-throw-out  f: 3
  8. ;   unwind-2  f: 2
  9. ;   unwind-1  f: 1
  10. ;   after-throw-out  f: top
  11. ;   wind-1  f: 1
  12. ;   wind-2  f: 2
  13. ;   after-throw-in  f: 3
  14. ;   unwind-2  f: 2
  15. ;   unwind-1  f: 1
  16. ;   done  f: top
  17.  
  18. (define (wind-test)
  19.   (let* ((f (make-fluid 'top))
  20.      (report (lambda (foo)
  21.            (write foo)
  22.            (display "  f: ")
  23.            (write (fluid f))
  24.            (newline))))
  25.     ((cwcc
  26.        (lambda (k1)
  27.      (let-fluid f 1
  28.        (lambda ()
  29.          (dynamic-wind
  30.           (lambda () (report 'wind-1))
  31.           (lambda ()
  32.         (let-fluid f 2
  33.           (lambda ()
  34.             (dynamic-wind
  35.              (lambda () (report 'wind-2))
  36.              (lambda ()
  37.                (let-fluid f 3
  38.              (lambda ()
  39.                (report 'before-throw-out)
  40.                (cwcc
  41.                  (lambda (k2)
  42.                    (k1 (lambda ()
  43.                      (report 'after-throw-out)
  44.                      (k2 #f)))))
  45.                (report 'after-throw-in)
  46.                (lambda () (report 'done)))))
  47.              (lambda () (report 'unwind-2))))))
  48.           (lambda () (report 'unwind-1))))))))))
  49.  
  50. (define cwcc call-with-current-continuation)
  51.           
  52.