mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-15 02:00:22 +02:00
Code Activity

make each invocation of `while' throw to different keys

Browse source 
* ice-9/boot-9.scm (while): Further fixes to while, brought out by the
  test suite. Also updated documentary comments.
This commit is contained in:
Andy Wingo 2008-10-11 15:03:00 +02:00
parent 27d43e3cf7
commit 972c33e592
1 changed files with 16 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

39
ice-9/boot-9.scm
View file

@ -2723,32 +2723,25 @@ module '(ice-9 q) '(make-q q-length))}."
;; The inner `do' loop avoids re-establishing a catch every iteration, ;; The inner `do' loop avoids re-establishing a catch every iteration,
;; that's only necessary if continue is actually used. A new key is ;; that's only necessary if continue is actually used. A new key is
;; generated every time, so break and continue apply to their originating ;; generated every time, so break and continue apply to their originating
;; `while' even when recursing. `while-helper' is an easy way to keep the ;; `while' even when recursing.
;; `key' binding away from the cond and body code.
;; ;;
;; FIXME: This is supposed to have an `unquote' on the `do' the same used ;; FIXME: This macro is unintentionally unhygienic with respect to let,
;; for lambda and not, so as to protect against any user rebinding of that ;; make-symbol, do, throw, catch, lambda, and not.
;; symbol, but unfortunately an unquote breaks with ice-9 syncase, eg.
;;
;; (use-modules (ice-9 syncase))
;; (while #f)
;; => ERROR: invalid syntax ()
;;
;; This is probably a bug in syncase.
;; ;;
(define-macro (while cond . body) (define-macro (while cond . body)
(let ((key (make-symbol "while-key"))) (let ((keyvar (make-symbol "while-keyvar")))
`(do () `(let ((,keyvar (make-symbol "while-key")))
((catch ',key (do ()
(lambda () ((catch ,keyvar
(let ((break (lambda () (throw ',key #t))) (lambda ()
(continue (lambda () (throw ',key #f)))) (let ((break (lambda () (throw ,keyvar #t)))
(do () (continue (lambda () (throw ,keyvar #f))))
((not ,cond)) (do ()
,@body) ((not ,cond))
#t)) ,@body)
(lambda (key arg) #t))
arg)))))) (lambda (key arg)
arg)))))))