control.scm 1.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354
  1. ;;; Delimited control
  2. ;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
  3. ;;;
  4. ;;; Licensed under the Apache License, Version 2.0 (the "License");
  5. ;;; you may not use this file except in compliance with the License.
  6. ;;; You may obtain a copy of the License at
  7. ;;;
  8. ;;; http://www.apache.org/licenses/LICENSE-2.0
  9. ;;;
  10. ;;; Unless required by applicable law or agreed to in writing, software
  11. ;;; distributed under the License is distributed on an "AS IS" BASIS,
  12. ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  13. ;;; See the License for the specific language governing permissions and
  14. ;;; limitations under the License.
  15. ;;; Commentary:
  16. ;;;
  17. ;;; Delimited control.
  18. ;;;
  19. ;;; Code:
  20. (define-module (ice-9 control)
  21. ;; FIXME: Guile re-exports some things from (guile), but these would
  22. ;; cause duplicate definition errors in impure define-module forms
  23. ;; right now.
  24. ;; #:re-export (call-with-prompt abort-to-prompt default-prompt-tag make-prompt-tag)
  25. #:use-module ((hoot control) #:select (%))
  26. #:export (%
  27. abort
  28. call-with-escape-continuation
  29. call/ec
  30. let-escape-continuation
  31. let/ec))
  32. (define (abort . args)
  33. (apply abort-to-prompt (default-prompt-tag) args))
  34. (define (call-with-escape-continuation proc)
  35. (let ((tag (make-prompt-tag 'escape)))
  36. (call-with-prompt tag
  37. (lambda ()
  38. (proc (lambda vals
  39. (apply abort-to-prompt tag vals))))
  40. (lambda (k . vals)
  41. (apply values vals)))))
  42. (define call/ec call-with-escape-continuation)
  43. (define-syntax-rule (let-escape-continuation k body ...)
  44. (call/ec (lambda (k) body ...)))
  45. (define-syntax-rule (let/ec k body ...)
  46. (let-escape-continuation k body ...))