escape.scm 1004 B

1234567891011121314151617181920212223242526272829303132333435
  1. ; Part of Scheme 48 1.9. See file COPYING for notices and license.
  2. ; Authors: Richard Kelsey, Jonathan Rees
  3. ; For an explanation, see comments in rts/low.scm.
  4. ; The debugger invokes EXTRACT-CONTINUATION on a "native" continuation
  5. ; as obtained by PRIMITIVE-CWCC in order to get a VM continuation.
  6. ; The distinction between native and VM continuations is useful when
  7. ; debugging a program running under a VM that's different from
  8. ; whatever machine is running the debugger.
  9. (define-record-type escape :escape
  10. (make-escape proc)
  11. (proc escape-procedure))
  12. (define (with-continuation esc thunk)
  13. (if esc
  14. ((escape-procedure esc) thunk)
  15. (let ((answer (thunk)))
  16. (signal 'vm-return answer) ;#f means halt
  17. (assertion-violation 'with-continuation "halt" answer))))
  18. (define (primitive-cwcc proc)
  19. (call-with-current-continuation
  20. (lambda (done)
  21. ((call-with-current-continuation
  22. (lambda (k)
  23. (call-with-values
  24. (lambda ()
  25. (proc (make-escape k)))
  26. done)))))))