diff options
-rw-r--r-- | doc/ref/api-control.texi | 18 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 18 | ||||
-rw-r--r-- | test-suite/tests/syntax.test | 17 |
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 |