diff options
| -rw-r--r-- | csc/loop.csc | 30 |
1 files changed, 12 insertions, 18 deletions
diff --git a/csc/loop.csc b/csc/loop.csc index 7f59f9e..4756e23 100644 --- a/csc/loop.csc +++ b/csc/loop.csc @@ -7,8 +7,16 @@ ; Once more, from the top! - (define (*current-loop-continuation* . args) - (error "Can't use return outside of a loop")) + (define-record-type <return-exception> + (make-return-exception thunk) + return-exception? + (thunk return-exception-values)) + + + (define-syntax return + (syntax-rules () + ((return expr) + (raise (make-return-exception (lambda () expr)))))) (define-record-type <loop-termination> @@ -398,19 +406,5 @@ (define-syntax loop (syntax-rules () ((loop clause* ...) - (call/cc - (lambda (k) - (define prev-loop-continuation *current-loop-continuation*) - (dynamic-wind - (lambda () - (set! *current-loop-continuation* k)) - (lambda () - (loop-aux "variable-clause-collector" (() ()) clause* ...)) - (lambda () - (set! *current-loop-continuation* prev-loop-continuation)))))))) - - - (define-syntax return - (syntax-rules () - ((return expr) - (call-with-values (lambda () expr) *current-loop-continuation*)))))) + (guard (e ((return-exception? e) ((return-exception-values e)))) + (loop-aux "variable-clause-collector" (() ()) clause* ...))))))) |