summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/ref/api-control.texi18
-rw-r--r--module/ice-9/boot-9.scm18
-rw-r--r--test-suite/tests/syntax.test17
3 files changed, 36 insertions, 17 deletions
diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi
index 1f33c43b5..1dde8ea9d 100644
--- a/doc/ref/api-control.texi
+++ b/doc/ref/api-control.texi
@@ -266,13 +266,12 @@ Concept of Closure}).
@deffn syntax while cond body @dots{}
Run a loop executing the @var{body} forms while @var{cond} is true.
@var{cond} is tested at the start of each iteration, so if it's
-@code{#f} the first time then @var{body} is not executed at all. The
-return value is unspecified.
+@code{#f} the first time then @var{body} is not executed at all.
Within @code{while}, two extra bindings are provided, they can be used
from both @var{cond} and @var{body}.
-@deffn {Scheme Procedure} break
+@deffn {Scheme Procedure} break break-arg...
Break out of the @code{while} form.
@end deffn
@@ -281,6 +280,19 @@ Abandon the current iteration, go back to the start and test
@var{cond} again, etc.
@end deffn
+If the loop terminates normally, by the @var{cond} evaluating to
+@code{#f}, then the @code{while} expression as a whole evaluates to
+@code{#f}. If it terminates by a call to @code{break} with some number
+of arguments, those arguments are returned from the @code{while}
+expression, as multiple values. Otherwise if it terminates by a call to
+@code{break} with no arguments, then return value is @code{#t}.
+
+@example
+(while #f (error "not reached")) @result{} #f
+(while #t (break)) @result{} #t
+(while #f (break 1 2 3)) @result{} 1 2 3
+@end example
+
Each @code{while} form gets its own @code{break} and @code{continue}
procedures, operating on that @code{while}. This means when loops are
nested the outer @code{break} can be used to escape all the way out.
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 84e76bded..401d90476 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2785,13 +2785,11 @@ module '(ice-9 q) '(make-q q-length))}."
(define-syntax #,(datum->syntax #'while 'break)
(lambda (x)
(syntax-case x ()
- ((_)
- #'(abort-to-prompt break-tag))
- ((_ . args)
- (syntax-violation 'break "too many arguments" x))
+ ((_ arg (... ...))
+ #'(abort-to-prompt break-tag arg (... ...)))
(_
- #'(lambda ()
- (abort-to-prompt break-tag))))))
+ #'(lambda args
+ (apply abort-to-prompt break-tag args))))))
(let lp ()
(call-with-prompt
continue-tag
@@ -2806,10 +2804,12 @@ module '(ice-9 q) '(make-q q-length))}."
(_
#'(lambda ()
(abort-to-prompt continue-tag))))))
- (do () ((not cond)) body ...))
+ (do () ((not cond) #f) body ...))
(lambda (k) (lp)))))
- (lambda (k)
- #t)))))))
+ (lambda (k . args)
+ (if (null? args)
+ #t
+ (apply values args)))))))))
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index b33df7cb6..f6eb28a67 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -983,11 +983,18 @@
(with-test-prefix "break"
- (pass-if-syntax-error "too many args" exception:too-many-args
- (eval '(while #t
- (break 1))
- (interaction-environment)))
-
+ (pass-if "normal return"
+ (not (while #f (error "not reached"))))
+
+ (pass-if "no args"
+ (while #t (break)))
+
+ (pass-if "multiple values"
+ (equal? '(1 2 3)
+ (call-with-values
+ (lambda () (while #t (break 1 2 3)))
+ list)))
+
(with-test-prefix "from cond"
(pass-if "first"
(while (begin